IMPLEMENTATION MODULE StrLogic; (* * REPERTOIRE * Release 1.6 * By Charles Bradford and Cole Brecheen * (c) Copyright 1985-1992 PMI * Green Bay, Wisconsin * All rights reserved * (414) 468-6040 * * $Header: D:/logfiles/mods/strlogic.mov 1.5 10 Mar 1991 15:33:48 coleb $ * *) IMPORT ErrorManager; IMPORT LowLevel; IMPORT M2Strings; IMPORT PosUtils; IMPORT StrConv; IMPORT StrEdit; IMPORT SYSTEM; VAR Initialized : BOOLEAN; PROCEDURE Init(); BEGIN IF Initialized THEN RETURN; ELSE Initialized := TRUE; END; ErrorManager.Init(); LowLevel.Init(); M2Strings.Init(); PosUtils.Init(); StrConv.Init(); StrEdit.Init(); DelimitingChars := ' ,()[].!?";'; EmbeddedStrMatters := TRUE; CaseSensitive := FALSE; END Init; CONST null = ''; VAR FatalError : BOOLEAN; PROCEDURE SpotInside( TheSpot: CARDINAL; TheStr: ARRAY OF CHAR ): BOOLEAN; BEGIN IF FatalError THEN RETURN FALSE END; IF TheSpot <= HIGH(TheStr) THEN RETURN TRUE; ELSE RETURN FALSE; END; END SpotInside; PROCEDURE CharCount(TheChar : CHAR; VAR TheStr : ARRAY OF CHAR) : CARDINAL; (*CharCount returns the number of TheChar's in TheStr. It is used in StrLogic to detect possible omissions of brackets and quotation marks, and should be deleted when a program is complete.*) BEGIN RETURN PosUtils.ByteCount(M2Strings.Length(TheStr), TheChar, SYSTEM.ADR(TheStr) ); END CharCount; PROCEDURE ExpressionTest(ObjectStr, FormulaList: ARRAY OF CHAR): CARDINAL; CONST ExpressionSeparator = '\'; blank = ' '; OrSymbol = '|'; AndSymbol = '&'; NotSymbol = '~'; LftBracket = '['; RtBracket = ']'; ExpansionChar = '*'; (*If FormulaList is more than zero bytes long, this routine copies string-analysis expressions out of FormulaList one-by- one. After it copies an expression it replaces the bytes it formerly occupied in FormulaList with blanks. It keeps going until FormulaList is all blank, or until one of the expressions returns a TRUE. It returns the number of that expression, or it returns 0 if none of the expressions are TRUE.*) PROCEDURE ThisExpression(object, formula : ARRAY OF CHAR) : BOOLEAN; (*ThisExpression is the routine that does the analysis of each individual expression in the FormulaList.*) TYPE LogicSymbol = (NoSmblAtAll, OrSmbl, AndSmbl, NotSmbl, lftbracket, rtbracket, ElementalStmt); CONST StackSize = 50; TotalSmbls = 3; VAR OnePattern : ARRAY [0..40] OF CHAR; SymbolCode : LogicSymbol; PrecedenceCount, OldFormulaPtr, OperatorStackPtr, ElementStackPtr : CARDINAL; ElementStack : ARRAY [1..StackSize] OF BOOLEAN; OperatorStack : ARRAY [0..StackSize] OF CARDINAL; (*Although it might look more elegant to make this an array of LogicSymbol's, we can't do it because we need to add numbers out of sequence to PrecedenceCount.*) PROCEDURE ElementTest(VAR TheElement, object : ARRAY OF CHAR) : BOOLEAN; (*ElementTest returns TRUE for the following statements about the sentence "A red car just ran over your cat." L < 60 [L means length in characters.] L = 33 'red' < 5 "car" > 5 'car' = 7 'cat' > 'car' W > 1 [W means words; represents number of DelimitingChars + 1] W = 8 It returns FALSE for such statements as: 'dog' < 20 [In other words, the fact that Pos would return a 0 for the string does not make the expression true. Both patterns in an expression have to be there for it to be true.] *) TYPE OperatorType = (NoOperator, EqualTo, UnequalTo, GreaterThan, GreaterThanOrEqualTo, LessThan, LessThanOrEqualTo); PROCEDURE GetOperator(VAR TheStr : ARRAY OF CHAR; VAR TheOperator : OperatorType; VAR TheSpot : CARDINAL); CONST operators = '=#><'; VAR QuoteMark : CHAR; (*Used to keep track of whether our quote mark is single or double.*) OpSpot, lngth, ndx : CARDINAL; InString : BOOLEAN; BEGIN (*GetOperator*) IF FatalError THEN RETURN END; lngth := M2Strings.Length(TheStr); ndx := 0; InString := FALSE; QuoteMark := 0C; TheSpot := 255; TheOperator := NoOperator; OpSpot := 5; (*OpSpot was uninitialized in Release 1.4; fixed in Release 1.5 thanks to Mike Smyth.*) WHILE (ndx' : TheOperator := GreaterThan; | '<' : TheOperator := LessThan; ELSE ErrorManager.WARN('TheSpot wrong in GetOperator.'); INC(StrLogicErrorLevel); FatalError := TRUE; RETURN; END; IF TheStr[ndx+1]='=' THEN INC(TheOperator); (*TheOperator should now be either GreaterThanOrEqualTo or LessThanOrEqualTo.*) END; END; INC(ndx); END; IF TheOperator=NoOperator THEN TheSpot := lngth; ELSIF TheSpot = 0 THEN ErrorManager.WARN('Operator cannot begin an expression.'); INC(StrLogicErrorLevel); FatalError := TRUE; END; END GetOperator; PROCEDURE PosOfOneTerm(ElementStr, ObjStr : ARRAY OF CHAR; spot1, spot2 : CARDINAL; VAR missing : BOOLEAN) : CARDINAL; VAR lngth, tmp, ndx : CARDINAL; TmpStr : ARRAY [0..80] OF CHAR; BEGIN (*PosOfOneTerm*) IF FatalError THEN RETURN 0 END; missing := FALSE; M2Strings.Copy(ElementStr, spot1, spot2-spot1+1, TmpStr); StrEdit.CutLeadingChars(blank, TmpStr); IF (TmpStr[0]="'") OR (TmpStr[0]='"') THEN StrEdit.DeleteChar(TmpStr[0], TmpStr); IF EmbeddedStrMatters THEN tmp := M2Strings.Pos(TmpStr,ObjStr); IF NOT SpotInside(tmp,ObjStr) THEN missing := TRUE; END; RETURN tmp; ELSE tmp := PosUtils.PosDelimited(TmpStr,ObjStr,DelimitingChars); IF NOT SpotInside(tmp,ObjStr) THEN missing := TRUE; END; RETURN tmp; END; ELSIF TmpStr[0]='L' THEN RETURN M2Strings.Length(ObjStr); ELSIF TmpStr[0]='W' THEN (*Count delimiters and return 0 or delimiters + 1.*) lngth := M2Strings.Length(ObjStr); ndx := 0; tmp := 0; WHILE ndx0) OR (lngth>0) THEN INC(tmp); END; RETURN tmp; ELSIF ((TmpStr[0]>='0') AND (TmpStr[0]<='9')) THEN IF StrConv.StrToCardinal(TmpStr,0,tmp) THEN RETURN tmp; ELSE StrEdit.Append( TmpStr, '-- This did not convert correctly.'); ErrorManager.WARN(TmpStr); INC(StrLogicErrorLevel); FatalError := TRUE; RETURN 0; END; ELSE StrEdit.Append( TmpStr, ' -- Illegal term in this StrLogic formula.'); ErrorManager.WARN(TmpStr); INC(StrLogicErrorLevel); FatalError := TRUE; RETURN 0; END; END PosOfOneTerm; VAR FirstTerm, SecondTerm, OperatorSpot : CARDINAL; TermMissing : BOOLEAN; TheOperator : OperatorType; BEGIN (*ElementTest*) IF FatalError THEN RETURN FALSE END; GetOperator(TheElement, TheOperator, OperatorSpot); IF FatalError THEN RETURN FALSE END; (*GetOperator cuts blanks, finds operaters if there are any, indicates what they are in TheOperator, and indicates where they are in OperatorSpot.*) FirstTerm := PosOfOneTerm(TheElement, object, 0, OperatorSpot-1, TermMissing); (*The terms we're talking about here can be simple strings (e.g., 'red'), decimal numbers, or length ('L') or width ('W') variables. PosOfOneTerm evaluates those things and gives us back a numeric result based on them.*) IF FatalError THEN RETURN FALSE END; IF TermMissing THEN RETURN FALSE; END; IF TheOperator#NoOperator THEN IF (TheOperator=GreaterThanOrEqualTo) OR (TheOperator= LessThanOrEqualTo) THEN INC(OperatorSpot); (*We have to do this because those symbols are two characters long, and we want OperatorSpot to indicate the last character of the operator in the next call to PosOfOneTerm.*) END; SecondTerm := PosOfOneTerm(TheElement, object, OperatorSpot+1, M2Strings.Length(TheElement), TermMissing); IF FatalError THEN RETURN FALSE END; IF TermMissing THEN RETURN FALSE; END; END; CASE TheOperator OF NoOperator : RETURN TRUE; (*We know it's TRUE here because if the term had been missing and there had been no operator, we would have returned FALSE above in the IF TermMissing statements.*) | EqualTo : RETURN (FirstTerm=SecondTerm); | UnequalTo : RETURN (FirstTerm#SecondTerm); | GreaterThan : RETURN (FirstTerm>SecondTerm); | GreaterThanOrEqualTo : RETURN (FirstTerm>=SecondTerm); | LessThan : RETURN (FirstTerm= FormulaLength) OR (TheOperator#ElementalStmt); IF ElementFound THEN IF TheOperator # ElementalStmt THEN DEC(FormulaPtr); (*We DEC this because the INC at the end of the loop makes it point to the character AFTER the next one to be processed. FormulaPtr is always supposed to be sitting on the next character.*) TheOperator := ElementalStmt; (*We set this back to ElementalStmt because the process of searching for the end of the statement messed up the value of TheOperator.*) END; M2Strings.Copy(formula, OldFormulaPtr, (FormulaPtr-OldFormulaPtr), TheElement); END; OldFormulaPtr := FormulaPtr; (*OldFormulaPtr gets updated in preparation for next call to GetSymbolFromFormula.*) END; END GetSymbolFromFormula; PROCEDURE PrecedenceOf(logicsymbol : LogicSymbol) : CARDINAL; BEGIN IF FatalError THEN RETURN 0 END; CASE logicsymbol OF NoSmblAtAll : RETURN (0); | OrSmbl : RETURN (1); | AndSmbl : RETURN (2); | NotSmbl : RETURN (3); | lftbracket : RETURN (4); | rtbracket : RETURN (5); ELSE ErrorManager.WARN('PrecedenceOf got a weird LogicSymbol.'); INC(StrLogicErrorLevel); FatalError := TRUE; RETURN 0; END; END PrecedenceOf; PROCEDURE ResolveStacks(); VAR Element : BOOLEAN; BEGIN (*ResolveStacks*) IF FatalError THEN RETURN END; WHILE (OperatorStackPtr>0) AND (OperatorStack[ OperatorStackPtr]>=PrecedenceOf(SymbolCode)+ PrecedenceCount) DO IF FatalError THEN RETURN END; Element := ElementStack[ElementStackPtr]; (*ElementStack is a stack of booleans.*) CASE OperatorStack[OperatorStackPtr] MOD TotalSmbls OF 1 : DEC(ElementStackPtr); Element := Element OR ElementStack[ElementStackPtr]; | 2 : DEC(ElementStackPtr); Element := Element AND ElementStack[ElementStackPtr]; | 0, 3 : Element := NOT Element; ELSE ErrorManager.WARN('Something strange in the OperatorStack.'); INC(StrLogicErrorLevel); FatalError := TRUE; RETURN; END; ElementStack[ElementStackPtr] := Element; DEC(OperatorStackPtr); END; END ResolveStacks; PROCEDURE AddToElementStack(TheElement : ARRAY OF CHAR); (*ElementStack is actually an array of booleans. AddToElementStack puts a TRUE or a FALSE in the ElementStack, depending on the presence or absence of TheElement in object.*) VAR tmp : BOOLEAN; BEGIN (*AddToElementStack*) IF FatalError THEN RETURN END; INC(ElementStackPtr); IF ElementStackPtr>StackSize THEN ErrorManager.WARN("Stack overflow in StrLogic."); INC(StrLogicErrorLevel); FatalError := TRUE; RETURN; END; tmp := ElementTest(TheElement,object); IF FatalError THEN RETURN END; ElementStack[ElementStackPtr] := tmp; END AddToElementStack; PROCEDURE AddToOperatorStack(symbol : LogicSymbol); VAR tmp : CARDINAL; BEGIN (*AddToOperatorStack*) IF FatalError THEN RETURN END; INC(OperatorStackPtr); tmp := PrecedenceOf(symbol)+PrecedenceCount; IF FatalError THEN RETURN END; OperatorStack[OperatorStackPtr] := tmp; END AddToOperatorStack; BEGIN (*ThisExpression*) IF FatalError THEN RETURN FALSE END; StrEdit.CrunchBlanks(object); StrEdit.CrunchBlanks(formula); IF NOT CaseSensitive THEN StrEdit.CAPstr(object); StrEdit.CAPstr(formula); END; OperatorStackPtr := 0; OperatorStack[OperatorStackPtr] := 0; ElementStackPtr := 0; PrecedenceCount := 0; OldFormulaPtr := 0; (*OldFormulaPtr should always point to the first character of the next pattern in the formula that needs to be processed.*) GetSymbolFromFormula(OnePattern, SymbolCode); IF SymbolCode=NoSmblAtAll THEN RETURN FALSE; ELSE REPEAT CASE SymbolCode OF ElementalStmt : AddToElementStack(OnePattern); IF FatalError THEN RETURN FALSE END; | OrSmbl, AndSmbl, NotSmbl : ResolveStacks(); IF FatalError THEN RETURN FALSE END; AddToOperatorStack(SymbolCode); | lftbracket : INC(PrecedenceCount, TotalSmbls); | rtbracket : DEC(PrecedenceCount, TotalSmbls); | NoSmblAtAll : ELSE ErrorManager.WARN('SymbolCode probably not set.'); INC(StrLogicErrorLevel); FatalError := TRUE; RETURN FALSE; END; (*case*) GetSymbolFromFormula(OnePattern, SymbolCode); UNTIL SymbolCode=NoSmblAtAll; ResolveStacks(); IF FatalError THEN RETURN FALSE END; IF ElementStackPtr<>1 THEN ErrorManager.WARN('ThisExpression error.'); INC(StrLogicErrorLevel); FatalError := TRUE; RETURN FALSE; END; RETURN (ElementStack[1]); END; END ThisExpression; VAR ExpressionIdentifier, EndOfIdentifier, StartOfExpr, EndOfExpr, lngth, FormulaNumber : CARDINAL; TempExpr : ARRAY [0..255] OF CHAR; BEGIN (*ExpressionTest*) FatalError := FALSE; StrLogicErrorLevel := 0; lngth := M2Strings.Length(FormulaList); IF lngth=0 THEN RETURN 0; END; FormulaNumber := 1; StrEdit.AssignStr(null, TempExpr); REPEAT StartOfExpr := CARDINAL( LowLevel.ScanNE(lngth, blank, SYSTEM.ADR(FormulaList))); (*If there are no leading blanks, StartOfExpr will be 0.*) IF FormulaList[StartOfExpr]=ExpressionSeparator THEN FormulaList[StartOfExpr] := blank; (*We have to do this to remove any leading backslash. We do it in a loop to make sure that StartOfExpr gets off on the right foot, but an incidental result is that all leading null expressions will be ignored.*) END; UNTIL FormulaList[StartOfExpr]#blank; EndOfExpr := CARDINAL(LowLevel.ScanEQ(lngth, ExpressionSeparator,SYSTEM.ADR(FormulaList))); (*If there's no ExpressionSeparator, EndOfExpr will equal lngth.*) WHILE (StartOfExpr+1)