home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Samples / BOZOL2 / BOZOL2.ZIP / CALC.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-02-08  |  2.5 KB  |  107 lines
  1. ' All of the following subroutines are necessary to perform the recursive
  2. ' descent parser.  CALC is the only callable routine, and must be passed
  3. ' a string containing a valid math expression.
  4. ' An invalid expression, such as (2**4) or (1+2+3+) will result in a
  5. ' SYNTAX ERROR message, printed on the screen by the sub PTV().  Mismatched
  6. ' parenthesis result in an error message displayed by sub LEVEL6().  These
  7. ' error messages could be replaced with the ERROR nn statement, allowing your
  8. ' own error-handling routines to report the error.
  9. '
  10. ' This routine supports boolean expressions (1>2) and unary operators (5*-1)
  11.  
  12. FUNCTION Calc (A$)
  13. Arg$=A$
  14. R = 0
  15. P = 1
  16. IF Arg$ = "" THEN GOTO EndCalcSub
  17. CALL GetExp(R)
  18. LET Calc = R
  19. EndCalcSub:
  20. END FUNCTION
  21.  
  22.  
  23. SUB Arith (OO$, R, H)
  24. IF OO$ = "-" THEN R = (R - H)
  25. IF OO$ = "+" THEN R = (R + H)
  26. IF OO$ = "*" THEN R = (R * H)
  27. IF OO$ = "/" THEN R = (R / H)
  28. IF OO$ = "^" THEN R = (R ^ H)
  29. IF OO$ = "<" THEN R = (R < H)
  30. IF OO$ = ">" THEN R = (R > H)
  31. IF OO$ = "=" THEN R = (R = H)
  32. END SUB
  33.  
  34. SUB GetExp (R)
  35. CALL GetToken
  36. CALL Level1(R)
  37. END SUB
  38.  
  39. SUB GetToken
  40. Token$ = ""
  41. WHILE MID$(Arg$, P, 1) = " ": P = P + 1: WEND
  42. IF INSTR("-+*/^()<>=", MID$(Arg$, P, 1)) THEN TokenType = 1: Token$ = MID$(Arg$, P, 1): P = P + 1: EXIT SUB
  43. IF MID$(Arg$, P, 1) >= "0" AND MID$(Arg$, P, 1) <= "9" THEN WHILE INSTR(" -+*/^()<>=", MID$(Arg$, P, 1)) = 0: Token$ = Token$ + MID$(Arg$, P, 1): P = P + 1: WEND: TokenType = 2
  44. END SUB
  45.  
  46. SUB Level1 (R)
  47. CALL Level2(R): OO$ = Token$
  48. WHILE OO$ = "<" OR OO$ = ">" OR OO$ = "="
  49. CALL GetToken
  50. CALL Level2(H)
  51. CALL Arith(OO$, R, H)
  52. OO$ = Token$
  53. WEND
  54. END SUB
  55.  
  56. SUB Level2 (R)
  57. CALL Level3(R)
  58. OO$ = Token$
  59. WHILE OO$ = "+" OR OO$ = "-"
  60. CALL GetToken
  61. CALL Level3(H)
  62. CALL Arith(OO$, R, H)
  63. OO$ = Token$
  64. WEND
  65. END SUB
  66.  
  67. SUB Level3 (R)
  68. CALL Level4(R)
  69. OO$ = Token$
  70. WHILE OO$ = "*" OR OO$ = "/"
  71. CALL GetToken
  72. CALL Level4(H)
  73. CALL Arith(OO$, R, H)
  74. OO$ = Token$
  75. WEND
  76. END SUB
  77.  
  78. SUB Level4 (R)
  79. CALL Level5(R)
  80. IF Token$ = "^" THEN CALL GetToken: CALL Level4(H): CALL Arith("^", R, H)
  81. END SUB
  82.  
  83. SUB Level5 (R)
  84. OO$ = ""
  85. IF TokenType = 1 AND (Token$ = "+" OR Token$ = "-") THEN OO$ = Token$: CALL GetToken
  86. CALL Level6(R): IF OO$ <> "" THEN CALL Un(OO$, R)
  87. END SUB
  88.  
  89. SUB Level6 (R)
  90. IF Token$ = "(" AND TokenType = 1 THEN 230
  91. CALL Ptv(R): EXIT SUB
  92. 230 CALL GetToken
  93. CALL Level1(R)
  94. IF Token$ <> ")" THEN ERROR 102
  95. CALL GetToken
  96. END SUB
  97.  
  98. SUB Ptv (R)
  99. IF TokenType = 2 THEN R = VAL(Token$): CALL GetToken: EXIT SUB
  100. ERROR 101
  101. END SUB
  102.  
  103. SUB Un (OO$, R)
  104. IF OO$ = "-" THEN R = -R
  105. END SUB
  106.  
  107.