STRLOGIC.MOD 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723
  1. IMPLEMENTATION MODULE StrLogic;
  2. (*
  3. * REPERTOIRE
  4. * Release 1.6
  5. * By Charles Bradford and Cole Brecheen
  6. * (c) Copyright 1985-1992 PMI
  7. * Green Bay, Wisconsin
  8. * All rights reserved
  9. * (414) 468-6040
  10. *
  11. * $Header: D:/logfiles/mods/strlogic.mov 1.5 10 Mar 1991 15:33:48 coleb $
  12. *
  13. *)
  14. IMPORT ErrorManager;
  15. IMPORT LowLevel;
  16. IMPORT M2Strings;
  17. IMPORT PosUtils;
  18. IMPORT StrConv;
  19. IMPORT StrEdit;
  20. IMPORT SYSTEM;
  21. VAR
  22. Initialized : BOOLEAN;
  23. PROCEDURE Init();
  24. BEGIN
  25. IF Initialized THEN
  26. RETURN;
  27. ELSE
  28. Initialized := TRUE;
  29. END;
  30. ErrorManager.Init();
  31. LowLevel.Init();
  32. M2Strings.Init();
  33. PosUtils.Init();
  34. StrConv.Init();
  35. StrEdit.Init();
  36. DelimitingChars := ' ,()[].!?";';
  37. EmbeddedStrMatters := TRUE;
  38. CaseSensitive := FALSE;
  39. END Init;
  40. CONST
  41. null = '';
  42. VAR
  43. FatalError : BOOLEAN;
  44. PROCEDURE SpotInside( TheSpot: CARDINAL;
  45. TheStr: ARRAY OF CHAR ): BOOLEAN;
  46. BEGIN
  47. IF FatalError THEN RETURN FALSE END;
  48. IF TheSpot <= HIGH(TheStr) THEN
  49. RETURN TRUE;
  50. ELSE
  51. RETURN FALSE;
  52. END;
  53. END SpotInside;
  54. PROCEDURE CharCount(TheChar : CHAR; VAR TheStr : ARRAY OF CHAR)
  55. : CARDINAL;
  56. (*CharCount returns the number of TheChar's in TheStr. It is
  57. used in StrLogic to detect possible omissions of brackets
  58. and quotation marks, and should be deleted when a program
  59. is complete.*)
  60. BEGIN
  61. RETURN PosUtils.ByteCount(M2Strings.Length(TheStr),
  62. TheChar,
  63. SYSTEM.ADR(TheStr) );
  64. END CharCount;
  65. PROCEDURE ExpressionTest(ObjectStr,
  66. FormulaList: ARRAY OF CHAR): CARDINAL;
  67. CONST
  68. ExpressionSeparator = '\';
  69. blank = ' ';
  70. OrSymbol = '|';
  71. AndSymbol = '&';
  72. NotSymbol = '~';
  73. LftBracket = '[';
  74. RtBracket = ']';
  75. ExpansionChar = '*';
  76. (*If FormulaList is more than zero bytes long, this routine
  77. copies string-analysis expressions out of FormulaList one-by-
  78. one. After it copies an expression it replaces the bytes it
  79. formerly occupied in FormulaList with blanks. It keeps going
  80. until FormulaList is all blank, or until one of the expressions
  81. returns a TRUE. It returns the number of that expression, or
  82. it returns 0 if none of the expressions are TRUE.*)
  83. PROCEDURE ThisExpression(object,
  84. formula : ARRAY OF CHAR) : BOOLEAN;
  85. (*ThisExpression is the routine that does the analysis of each
  86. individual expression in the FormulaList.*)
  87. TYPE
  88. LogicSymbol = (NoSmblAtAll, OrSmbl, AndSmbl, NotSmbl,
  89. lftbracket, rtbracket, ElementalStmt);
  90. CONST
  91. StackSize = 50;
  92. TotalSmbls = 3;
  93. VAR
  94. OnePattern : ARRAY [0..40] OF CHAR;
  95. SymbolCode : LogicSymbol;
  96. PrecedenceCount, OldFormulaPtr, OperatorStackPtr,
  97. ElementStackPtr : CARDINAL;
  98. ElementStack : ARRAY [1..StackSize] OF BOOLEAN;
  99. OperatorStack : ARRAY [0..StackSize] OF CARDINAL;
  100. (*Although it might look more elegant to make this an
  101. array of LogicSymbol's, we can't do it because we need
  102. to add numbers out of sequence to PrecedenceCount.*)
  103. PROCEDURE ElementTest(VAR TheElement,
  104. object : ARRAY OF CHAR) : BOOLEAN;
  105. (*ElementTest returns TRUE for the following statements about the
  106. sentence "A red car just ran over your cat."
  107. L < 60
  108. [L means length in characters.]
  109. L = 33
  110. 'red' < 5
  111. "car" > 5
  112. 'car' = 7
  113. 'cat' > 'car'
  114. W > 1
  115. [W means words; represents number of DelimitingChars + 1]
  116. W = 8
  117. It returns FALSE for such statements as:
  118. 'dog' < 20
  119. [In other words, the fact that Pos would return a 0 for the
  120. string does not make the expression true. Both patterns in
  121. an expression have to be there for it to be true.]
  122. *)
  123. TYPE
  124. OperatorType = (NoOperator, EqualTo, UnequalTo, GreaterThan,
  125. GreaterThanOrEqualTo, LessThan, LessThanOrEqualTo);
  126. PROCEDURE GetOperator(VAR TheStr : ARRAY OF CHAR;
  127. VAR TheOperator : OperatorType;
  128. VAR TheSpot : CARDINAL);
  129. CONST
  130. operators = '=#><';
  131. VAR
  132. QuoteMark : CHAR;
  133. (*Used to keep track of whether our quote mark is
  134. single or double.*)
  135. OpSpot, lngth, ndx : CARDINAL;
  136. InString : BOOLEAN;
  137. BEGIN
  138. (*GetOperator*)
  139. IF FatalError THEN RETURN END;
  140. lngth := M2Strings.Length(TheStr);
  141. ndx := 0;
  142. InString := FALSE;
  143. QuoteMark := 0C;
  144. TheSpot := 255;
  145. TheOperator := NoOperator;
  146. OpSpot := 5;
  147. (*OpSpot was uninitialized in Release 1.4; fixed in
  148. Release 1.5 thanks to Mike Smyth.*)
  149. WHILE (ndx<lngth) AND (TheOperator=NoOperator) DO
  150. IF (TheStr[ndx]='"') OR (TheStr[ndx]="'") THEN
  151. (*The stuff in this IF statement allows nesting a
  152. single quote mark inside double quote marks, or
  153. vice versa.*)
  154. IF QuoteMark=0C THEN
  155. QuoteMark := TheStr[ndx];
  156. END;
  157. IF TheStr[ndx]=QuoteMark THEN
  158. InString := NOT InString;
  159. END;
  160. END;
  161. IF NOT InString THEN
  162. IF TheStr[ndx]=blank THEN
  163. M2Strings.Delete(TheStr, ndx, 1);
  164. (*This strips all but the blanks in strings. I'm
  165. not sure it's working; we seem to be doing some
  166. redundant blank stripping, but things go
  167. wrong if you try to strip blanks in only one
  168. place.*)
  169. END;
  170. OpSpot := M2Strings.Pos( TheStr[ndx], operators );
  171. IF SpotInside( OpSpot, operators ) THEN
  172. TheSpot := ndx;
  173. ELSE
  174. TheSpot := 255;
  175. (*Actually, we just want TheSpot to be some
  176. number bigger than the HIGH of operators, but
  177. Logitech won't let us get the HIGH of a constant.*)
  178. END;
  179. END;
  180. IF SpotInside( OpSpot, operators ) THEN
  181. CASE TheStr[ndx] OF
  182. '=' :
  183. TheOperator := EqualTo;
  184. | '#' :
  185. TheOperator := UnequalTo;
  186. | '>' :
  187. TheOperator := GreaterThan;
  188. | '<' :
  189. TheOperator := LessThan;
  190. ELSE
  191. ErrorManager.WARN('TheSpot wrong in GetOperator.');
  192. INC(StrLogicErrorLevel);
  193. FatalError := TRUE;
  194. RETURN;
  195. END;
  196. IF TheStr[ndx+1]='=' THEN
  197. INC(TheOperator);
  198. (*TheOperator should now be either
  199. GreaterThanOrEqualTo or LessThanOrEqualTo.*)
  200. END;
  201. END;
  202. INC(ndx);
  203. END;
  204. IF TheOperator=NoOperator THEN
  205. TheSpot := lngth;
  206. ELSIF TheSpot = 0 THEN
  207. ErrorManager.WARN('Operator cannot begin an expression.');
  208. INC(StrLogicErrorLevel);
  209. FatalError := TRUE;
  210. END;
  211. END GetOperator;
  212. PROCEDURE PosOfOneTerm(ElementStr, ObjStr : ARRAY OF CHAR;
  213. spot1, spot2 : CARDINAL;
  214. VAR missing : BOOLEAN) : CARDINAL;
  215. VAR
  216. lngth, tmp, ndx : CARDINAL;
  217. TmpStr : ARRAY [0..80] OF CHAR;
  218. BEGIN
  219. (*PosOfOneTerm*)
  220. IF FatalError THEN RETURN 0 END;
  221. missing := FALSE;
  222. M2Strings.Copy(ElementStr, spot1, spot2-spot1+1, TmpStr);
  223. StrEdit.CutLeadingChars(blank, TmpStr);
  224. IF (TmpStr[0]="'") OR (TmpStr[0]='"') THEN
  225. StrEdit.DeleteChar(TmpStr[0], TmpStr);
  226. IF EmbeddedStrMatters THEN
  227. tmp := M2Strings.Pos(TmpStr,ObjStr);
  228. IF NOT SpotInside(tmp,ObjStr) THEN
  229. missing := TRUE;
  230. END;
  231. RETURN tmp;
  232. ELSE
  233. tmp := PosUtils.PosDelimited(TmpStr,ObjStr,DelimitingChars);
  234. IF NOT SpotInside(tmp,ObjStr) THEN
  235. missing := TRUE;
  236. END;
  237. RETURN tmp;
  238. END;
  239. ELSIF TmpStr[0]='L' THEN
  240. RETURN M2Strings.Length(ObjStr);
  241. ELSIF TmpStr[0]='W' THEN
  242. (*Count delimiters and return 0 or delimiters + 1.*)
  243. lngth := M2Strings.Length(ObjStr);
  244. ndx := 0;
  245. tmp := 0;
  246. WHILE ndx<lngth DO
  247. IF PosUtils.Present(ObjStr[ndx],DelimitingChars) THEN
  248. INC(tmp);
  249. END;
  250. INC(ndx);
  251. END;
  252. IF (tmp>0) OR (lngth>0) THEN
  253. INC(tmp);
  254. END;
  255. RETURN tmp;
  256. ELSIF ((TmpStr[0]>='0') AND (TmpStr[0]<='9')) THEN
  257. IF StrConv.StrToCardinal(TmpStr,0,tmp) THEN
  258. RETURN tmp;
  259. ELSE
  260. StrEdit.Append( TmpStr, '-- This did not convert correctly.');
  261. ErrorManager.WARN(TmpStr);
  262. INC(StrLogicErrorLevel);
  263. FatalError := TRUE;
  264. RETURN 0;
  265. END;
  266. ELSE
  267. StrEdit.Append( TmpStr,
  268. ' -- Illegal term in this StrLogic formula.');
  269. ErrorManager.WARN(TmpStr);
  270. INC(StrLogicErrorLevel);
  271. FatalError := TRUE;
  272. RETURN 0;
  273. END;
  274. END PosOfOneTerm;
  275. VAR
  276. FirstTerm, SecondTerm, OperatorSpot : CARDINAL;
  277. TermMissing : BOOLEAN;
  278. TheOperator : OperatorType;
  279. BEGIN
  280. (*ElementTest*)
  281. IF FatalError THEN RETURN FALSE END;
  282. GetOperator(TheElement, TheOperator, OperatorSpot);
  283. IF FatalError THEN RETURN FALSE END;
  284. (*GetOperator cuts blanks, finds operaters if there are any,
  285. indicates what they are in TheOperator, and indicates where
  286. they are in OperatorSpot.*)
  287. FirstTerm := PosOfOneTerm(TheElement,
  288. object,
  289. 0,
  290. OperatorSpot-1,
  291. TermMissing);
  292. (*The terms we're talking about here can be simple strings
  293. (e.g., 'red'), decimal numbers, or length ('L') or width
  294. ('W') variables. PosOfOneTerm evaluates those things
  295. and gives us back a numeric result based on them.*)
  296. IF FatalError THEN RETURN FALSE END;
  297. IF TermMissing THEN
  298. RETURN FALSE;
  299. END;
  300. IF TheOperator#NoOperator THEN
  301. IF (TheOperator=GreaterThanOrEqualTo) OR (TheOperator=
  302. LessThanOrEqualTo) THEN
  303. INC(OperatorSpot);
  304. (*We have to do this because those symbols are two
  305. characters long, and we want OperatorSpot to
  306. indicate the last character of the operator in the
  307. next call to PosOfOneTerm.*)
  308. END;
  309. SecondTerm := PosOfOneTerm(TheElement,
  310. object,
  311. OperatorSpot+1,
  312. M2Strings.Length(TheElement),
  313. TermMissing);
  314. IF FatalError THEN RETURN FALSE END;
  315. IF TermMissing THEN
  316. RETURN FALSE;
  317. END;
  318. END;
  319. CASE TheOperator OF
  320. NoOperator :
  321. RETURN TRUE;
  322. (*We know it's TRUE here because if the term had
  323. been missing and there had been no operator, we
  324. would have returned FALSE above in the IF TermMissing
  325. statements.*)
  326. | EqualTo :
  327. RETURN (FirstTerm=SecondTerm);
  328. | UnequalTo :
  329. RETURN (FirstTerm#SecondTerm);
  330. | GreaterThan :
  331. RETURN (FirstTerm>SecondTerm);
  332. | GreaterThanOrEqualTo :
  333. RETURN (FirstTerm>=SecondTerm);
  334. | LessThan :
  335. RETURN (FirstTerm<SecondTerm);
  336. | LessThanOrEqualTo :
  337. RETURN (FirstTerm<=SecondTerm);
  338. ELSE
  339. ErrorManager.WARN('Weird operator in ElementTest.');
  340. INC(StrLogicErrorLevel);
  341. FatalError := TRUE;
  342. RETURN FALSE;
  343. END;
  344. END ElementTest;
  345. PROCEDURE GetSymbolFromFormula(VAR TheElement : ARRAY OF CHAR;
  346. VAR TheOperator : LogicSymbol);
  347. VAR
  348. FormulaLength, FormulaPtr : CARDINAL;
  349. InString, ElementFound : BOOLEAN;
  350. QuoteMark: CHAR;
  351. BEGIN
  352. (*GetSymbolFromFormula*)
  353. IF FatalError THEN RETURN END;
  354. FormulaLength := M2Strings.Length(formula);
  355. QuoteMark := 0C;
  356. StrEdit.AssignStr(null, TheElement);
  357. InString := FALSE;
  358. TheOperator := NoSmblAtAll;
  359. ElementFound := FALSE;
  360. IF (OldFormulaPtr+1) <= FormulaLength THEN
  361. FormulaPtr := OldFormulaPtr;
  362. (*OldFormulaPtr starts at 0, and subsequently points
  363. at the first character of the next word or symbol needing
  364. to be processed.*)
  365. REPEAT
  366. (*Look for next operator.*)
  367. IF (NOT InString) THEN
  368. WHILE formula[FormulaPtr]=blank DO
  369. M2Strings.Delete(formula, FormulaPtr, 1);
  370. END;
  371. END;
  372. IF (formula[FormulaPtr]='"')
  373. OR (formula[FormulaPtr]="'") THEN
  374. IF QuoteMark = 0C THEN
  375. QuoteMark := formula[FormulaPtr];
  376. END;
  377. IF formula[FormulaPtr] = QuoteMark THEN
  378. InString := NOT InString;
  379. IF NOT InString THEN
  380. QuoteMark := 0C;
  381. END;
  382. END;
  383. END;
  384. IF NOT InString THEN
  385. CASE formula[FormulaPtr] OF
  386. OrSymbol :
  387. TheOperator := OrSmbl;
  388. | AndSymbol :
  389. TheOperator := AndSmbl;
  390. | NotSymbol :
  391. TheOperator := NotSmbl;
  392. | LftBracket :
  393. TheOperator := lftbracket;
  394. | RtBracket :
  395. TheOperator := rtbracket;
  396. ELSE
  397. TheOperator := ElementalStmt;
  398. ElementFound := TRUE;
  399. END;
  400. ELSE
  401. TheOperator := ElementalStmt;
  402. ElementFound := TRUE;
  403. END;
  404. WHILE InString DO
  405. (*skip to the end of the string*)
  406. INC(FormulaPtr);
  407. IF formula[FormulaPtr] = QuoteMark THEN
  408. InString := NOT InString;
  409. IF NOT InString THEN
  410. QuoteMark := 0C;
  411. END;
  412. END;
  413. END;
  414. INC(FormulaPtr);
  415. UNTIL (FormulaPtr >= FormulaLength)
  416. OR (TheOperator#ElementalStmt);
  417. IF ElementFound THEN
  418. IF TheOperator # ElementalStmt THEN
  419. DEC(FormulaPtr);
  420. (*We DEC this because the INC at the
  421. end of the loop makes it point to the character
  422. AFTER the next one to be processed. FormulaPtr
  423. is always supposed to be sitting on the next
  424. character.*)
  425. TheOperator := ElementalStmt;
  426. (*We set this back to ElementalStmt because the
  427. process of searching for the end of the statement
  428. messed up the value of TheOperator.*)
  429. END;
  430. M2Strings.Copy(formula, OldFormulaPtr,
  431. (FormulaPtr-OldFormulaPtr), TheElement);
  432. END;
  433. OldFormulaPtr := FormulaPtr;
  434. (*OldFormulaPtr gets updated in preparation for next call
  435. to GetSymbolFromFormula.*)
  436. END;
  437. END GetSymbolFromFormula;
  438. PROCEDURE PrecedenceOf(logicsymbol : LogicSymbol) : CARDINAL;
  439. BEGIN
  440. IF FatalError THEN RETURN 0 END;
  441. CASE logicsymbol OF
  442. NoSmblAtAll :
  443. RETURN (0);
  444. | OrSmbl :
  445. RETURN (1);
  446. | AndSmbl :
  447. RETURN (2);
  448. | NotSmbl :
  449. RETURN (3);
  450. | lftbracket :
  451. RETURN (4);
  452. | rtbracket :
  453. RETURN (5);
  454. ELSE
  455. ErrorManager.WARN('PrecedenceOf got a weird LogicSymbol.');
  456. INC(StrLogicErrorLevel);
  457. FatalError := TRUE;
  458. RETURN 0;
  459. END;
  460. END PrecedenceOf;
  461. PROCEDURE ResolveStacks();
  462. VAR
  463. Element : BOOLEAN;
  464. BEGIN
  465. (*ResolveStacks*)
  466. IF FatalError THEN RETURN END;
  467. WHILE (OperatorStackPtr>0) AND (OperatorStack[
  468. OperatorStackPtr]>=PrecedenceOf(SymbolCode)+
  469. PrecedenceCount) DO
  470. IF FatalError THEN RETURN END;
  471. Element := ElementStack[ElementStackPtr];
  472. (*ElementStack is a stack of booleans.*)
  473. CASE OperatorStack[OperatorStackPtr] MOD TotalSmbls OF
  474. 1 :
  475. DEC(ElementStackPtr);
  476. Element := Element OR ElementStack[ElementStackPtr];
  477. | 2 :
  478. DEC(ElementStackPtr);
  479. Element := Element AND ElementStack[ElementStackPtr];
  480. | 0, 3 :
  481. Element := NOT Element;
  482. ELSE
  483. ErrorManager.WARN('Something strange in the OperatorStack.');
  484. INC(StrLogicErrorLevel);
  485. FatalError := TRUE;
  486. RETURN;
  487. END;
  488. ElementStack[ElementStackPtr] := Element;
  489. DEC(OperatorStackPtr);
  490. END;
  491. END ResolveStacks;
  492. PROCEDURE AddToElementStack(TheElement : ARRAY OF CHAR);
  493. (*ElementStack is actually an array of booleans.
  494. AddToElementStack puts a TRUE or a FALSE in the ElementStack,
  495. depending on the presence or absence of TheElement in object.*)
  496. VAR
  497. tmp : BOOLEAN;
  498. BEGIN
  499. (*AddToElementStack*)
  500. IF FatalError THEN RETURN END;
  501. INC(ElementStackPtr);
  502. IF ElementStackPtr>StackSize THEN
  503. ErrorManager.WARN("Stack overflow in StrLogic.");
  504. INC(StrLogicErrorLevel);
  505. FatalError := TRUE;
  506. RETURN;
  507. END;
  508. tmp := ElementTest(TheElement,object);
  509. IF FatalError THEN RETURN END;
  510. ElementStack[ElementStackPtr] := tmp;
  511. END AddToElementStack;
  512. PROCEDURE AddToOperatorStack(symbol : LogicSymbol);
  513. VAR
  514. tmp : CARDINAL;
  515. BEGIN
  516. (*AddToOperatorStack*)
  517. IF FatalError THEN RETURN END;
  518. INC(OperatorStackPtr);
  519. tmp := PrecedenceOf(symbol)+PrecedenceCount;
  520. IF FatalError THEN RETURN END;
  521. OperatorStack[OperatorStackPtr] := tmp;
  522. END AddToOperatorStack;
  523. BEGIN
  524. (*ThisExpression*)
  525. IF FatalError THEN RETURN FALSE END;
  526. StrEdit.CrunchBlanks(object);
  527. StrEdit.CrunchBlanks(formula);
  528. IF NOT CaseSensitive THEN
  529. StrEdit.CAPstr(object);
  530. StrEdit.CAPstr(formula);
  531. END;
  532. OperatorStackPtr := 0;
  533. OperatorStack[OperatorStackPtr] := 0;
  534. ElementStackPtr := 0;
  535. PrecedenceCount := 0;
  536. OldFormulaPtr := 0;
  537. (*OldFormulaPtr should always point to
  538. the first character of the next pattern
  539. in the formula that needs to be processed.*)
  540. GetSymbolFromFormula(OnePattern, SymbolCode);
  541. IF SymbolCode=NoSmblAtAll THEN
  542. RETURN FALSE;
  543. ELSE
  544. REPEAT
  545. CASE SymbolCode OF
  546. ElementalStmt :
  547. AddToElementStack(OnePattern);
  548. IF FatalError THEN RETURN FALSE END;
  549. | OrSmbl, AndSmbl, NotSmbl :
  550. ResolveStacks();
  551. IF FatalError THEN RETURN FALSE END;
  552. AddToOperatorStack(SymbolCode);
  553. | lftbracket :
  554. INC(PrecedenceCount, TotalSmbls);
  555. | rtbracket :
  556. DEC(PrecedenceCount, TotalSmbls);
  557. | NoSmblAtAll :
  558. ELSE
  559. ErrorManager.WARN('SymbolCode probably not set.');
  560. INC(StrLogicErrorLevel);
  561. FatalError := TRUE;
  562. RETURN FALSE;
  563. END;
  564. (*case*)
  565. GetSymbolFromFormula(OnePattern, SymbolCode);
  566. UNTIL SymbolCode=NoSmblAtAll;
  567. ResolveStacks();
  568. IF FatalError THEN RETURN FALSE END;
  569. IF ElementStackPtr<>1 THEN
  570. ErrorManager.WARN('ThisExpression error.');
  571. INC(StrLogicErrorLevel);
  572. FatalError := TRUE;
  573. RETURN FALSE;
  574. END;
  575. RETURN (ElementStack[1]);
  576. END;
  577. END ThisExpression;
  578. VAR
  579. ExpressionIdentifier, EndOfIdentifier, StartOfExpr, EndOfExpr,
  580. lngth, FormulaNumber : CARDINAL;
  581. TempExpr : ARRAY [0..255] OF CHAR;
  582. BEGIN
  583. (*ExpressionTest*)
  584. FatalError := FALSE;
  585. StrLogicErrorLevel := 0;
  586. lngth := M2Strings.Length(FormulaList);
  587. IF lngth=0 THEN
  588. RETURN 0;
  589. END;
  590. FormulaNumber := 1;
  591. StrEdit.AssignStr(null, TempExpr);
  592. REPEAT
  593. StartOfExpr := CARDINAL(
  594. LowLevel.ScanNE(lngth, blank, SYSTEM.ADR(FormulaList)));
  595. (*If there are no leading blanks, StartOfExpr will be 0.*)
  596. IF FormulaList[StartOfExpr]=ExpressionSeparator THEN
  597. FormulaList[StartOfExpr] := blank;
  598. (*We have to do this to remove any leading backslash.
  599. We do it in a loop to make sure that StartOfExpr gets
  600. off on the right foot, but an incidental result is
  601. that all leading null expressions will be ignored.*)
  602. END;
  603. UNTIL FormulaList[StartOfExpr]#blank;
  604. EndOfExpr := CARDINAL(LowLevel.ScanEQ(lngth,
  605. ExpressionSeparator,SYSTEM.ADR(FormulaList)));
  606. (*If there's no ExpressionSeparator, EndOfExpr will equal lngth.*)
  607. WHILE (StartOfExpr+1)<lngth DO
  608. (*It's StartOfExpr + 1 because StartOfExpr is always going
  609. to represent the number of bytes you have to skip to get
  610. from the first byte in FormulaList to the first byte of
  611. the expression you're interested in.*)
  612. LowLevel.Move(
  613. LowLevel.AddAddr(SYSTEM.ADR(FormulaList), StartOfExpr),
  614. SYSTEM.ADR(TempExpr),
  615. EndOfExpr-StartOfExpr);
  616. StrEdit.SetLength(TempExpr, EndOfExpr-StartOfExpr);
  617. IF ODD(CharCount("'",TempExpr)) THEN
  618. (*This and the following three IF tests should be
  619. deleted when your application is complete.*)
  620. StrEdit.Append( TempExpr,
  621. '-- Single quotation marks may be unbalanced.');
  622. ErrorManager.WARN(TempExpr);
  623. INC(StrLogicErrorLevel);
  624. FatalError := TRUE;
  625. RETURN 0;
  626. END;
  627. IF ODD(CharCount('"',TempExpr)) THEN
  628. StrEdit.Append( TempExpr,
  629. '-- Double quotation marks may be unbalanced.');
  630. ErrorManager.WARN(TempExpr);
  631. INC(StrLogicErrorLevel);
  632. FatalError := TRUE;
  633. RETURN 0;
  634. END;
  635. IF CharCount('[',TempExpr)#CharCount(']',TempExpr) THEN
  636. StrEdit.Append( TempExpr, '-- Brackets may be unbalanced.' );
  637. ErrorManager.WARN(TempExpr);
  638. INC(StrLogicErrorLevel);
  639. FatalError := TRUE;
  640. RETURN 0;
  641. END;
  642. IF CharCount('(',TempExpr)#CharCount(')',TempExpr) THEN
  643. StrEdit.Append( TempExpr,'-- Parentheses may be unbalanced.');
  644. ErrorManager.WARN(TempExpr);
  645. INC(StrLogicErrorLevel);
  646. FatalError := TRUE;
  647. RETURN 0;
  648. END;
  649. LowLevel.Fill(SYSTEM.ADR(FormulaList), EndOfExpr+1, blank);
  650. StrEdit.CutLeadingChars(blank, TempExpr);
  651. IF M2Strings.Pos('(',TempExpr)=0 THEN
  652. (*The opening parenthesis immediately after the
  653. ExpressionSeparator tells us that this expression
  654. has an ExpressionIdentifier.*)
  655. IF NOT StrConv.StrToCardinal(TempExpr,1,ExpressionIdentifier) THEN
  656. StrEdit.Append( TempExpr,
  657. '-- Needs a number after the opening parenthesis.');
  658. ErrorManager.WARN(TempExpr);
  659. INC(StrLogicErrorLevel);
  660. FatalError := TRUE;
  661. RETURN 0;
  662. END;
  663. IF ExpressionIdentifier=0 THEN
  664. StrEdit.Append( TempExpr,
  665. " You can't use 0 as an ExpressionIdentifier.");
  666. ErrorManager.WARN(TempExpr);
  667. INC(StrLogicErrorLevel);
  668. FatalError := TRUE;
  669. RETURN 0;
  670. END;
  671. EndOfIdentifier := M2Strings.Pos(')',TempExpr);
  672. M2Strings.Delete(TempExpr, 0, EndOfIdentifier + 1);
  673. ELSE
  674. ExpressionIdentifier := 0;
  675. END;
  676. IF ThisExpression(ObjectStr,TempExpr) THEN
  677. IF FatalError THEN RETURN 0 END;
  678. IF ExpressionIdentifier=0 THEN
  679. RETURN FormulaNumber;
  680. ELSE
  681. RETURN ExpressionIdentifier;
  682. END;
  683. END;
  684. StartOfExpr := CARDINAL(LowLevel.ScanNE(lngth,
  685. blank,
  686. SYSTEM.ADR(FormulaList)));
  687. (*We look for the first nonblank because we wipe out previously
  688. tested expressions with blanks.*)
  689. EndOfExpr := CARDINAL(LowLevel.ScanEQ(lngth,
  690. ExpressionSeparator,SYSTEM.ADR(FormulaList)));
  691. INC(FormulaNumber);
  692. END;
  693. RETURN 0;
  694. END ExpressionTest;
  695. BEGIN
  696. Initialized := FALSE;
  697. Init();
  698. END StrLogic.