home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / RECURSE.ZIP / RECURSE.BAS < prev    next >
BASIC Source File  |  1989-02-26  |  3KB  |  74 lines
  1. DECLARE SUB L1 (R!)
  2. DECLARE SUB GET.EXP (R!)
  3. DECLARE SUB GET.TOKEN ()
  4. DECLARE SUB L2 (R!)
  5. DECLARE SUB L3 (R!)
  6. DECLARE SUB ARITH (O$, R!, H!)
  7. DECLARE SUB L4 (R!)
  8. DECLARE SUB L5 (R!)
  9. DECLARE SUB L6 (R!)
  10. DECLARE SUB UNARY (O$, R!)
  11. DECLARE SUB PRIMITIVE (R!)
  12. 10 DIM AR(26): COMMON SHARED AR(), PROG$, TOKEN$, TOK.TYPE, P: ON ERROR GOTO 1000
  13. 20 FOR L = 1 TO 26: AR(L) = L: NEXT
  14. 30 R = 0: PRINT "TYPE IN EQUATION (EXAMPLE: 2.1/33)": INPUT PROG$: P = 1: IF PROG$ = "" THEN END
  15. 40 CALL GET.EXP(R): PRINT R: GOTO 30
  16. 50 GOTO 30
  17. 1000 PRINT ERR; ERL: RESUME 1001
  18. 1001 STOP
  19.  
  20. 270 SUB ARITH (O$, R, H)
  21. 280 IF O$ = "-" THEN R = R - H
  22. 290 IF O$ = "+" THEN R = R + H
  23. 300 IF O$ = "*" THEN R = R * H
  24. 310 IF O$ = "/" THEN R = R / H
  25. 320 IF O$ = "^" THEN R = R ^ H
  26. 321 IF O$ = "<" THEN R = R < H
  27. 322 IF O$ = ">" THEN R = R > H
  28. 323 IF O$ = "=" THEN R = R = H
  29. 330 END SUB
  30.  
  31. 60 SUB GET.EXP (R) : CALL GET.TOKEN
  32. 70 CALL L1(R): END SUB
  33.  
  34. 370 SUB GET.TOKEN : TOKEN$ = ""
  35. 380 WHILE MID$(PROG$, P, 1) = " ": P = P + 1: WEND
  36. 390 IF INSTR("-+*/^()<>=", MID$(PROG$, P, 1)) THEN TOK.TYPE = 1: TOKEN$ = MID$(PROG$, P, 1): P = P + 1: EXIT SUB
  37. 400 IF MID$(PROG$, P, 1) >= "0" AND MID$(PROG$, P, 1) <= "9" THEN WHILE INSTR(" -+*/^()<>=", MID$(PROG$, P, 1)) = 0: TOKEN$ = TOKEN$ + MID$(PROG$, P, 1): P = P + 1: WEND: TOK.TYPE = 2
  38. 410 END SUB
  39.  
  40. SUB L1 (R)
  41. CALL L2(R): O$ = TOKEN$
  42. WHILE O$ = "<" OR O$ = ">" OR O$ = "=": CALL GET.TOKEN: CALL L2(H): CALL ARITH(O$, R, H): O$ = TOKEN$: WEND
  43. END SUB
  44.  
  45. 80 SUB L2 (R) : CALL L3(R): O$ = TOKEN$
  46. 90 WHILE O$ = "+" OR O$ = "-": CALL GET.TOKEN: CALL L3(H): CALL ARITH(O$, R, H): O$ = TOKEN$
  47. 100 WEND: END SUB
  48.  
  49. 110 SUB L3 (R) : CALL L4(R): O$ = TOKEN$
  50. 120 WHILE O$ = "*" OR O$ = "/": CALL GET.TOKEN: CALL L4(H): CALL ARITH(O$, R, H): O$ = TOKEN$
  51. 130 WEND: END SUB
  52.  
  53. 140 SUB L4 (R) : CALL L5(R)
  54. 150 IF TOKEN$ = "^" THEN CALL GET.TOKEN: CALL L4(H): CALL ARITH("^", R, H)
  55. 160 END SUB
  56.  
  57. 170 SUB L5 (R) : O$ = ""
  58. 180 IF TOK.TYPE = 1 AND (TOKEN$ = "+" OR TOKEN$ = "-") THEN O$ = TOKEN$: CALL GET.TOKEN
  59. 190 CALL L6(R): IF O$ <> "" THEN CALL UNARY(O$, R)
  60. 200 END SUB
  61.  
  62. 210 SUB L6 (R) : IF TOKEN$ = "(" AND TOK.TYPE = 1 THEN 230
  63. 220 CALL PRIMITIVE(R): EXIT SUB
  64. 230 CALL GET.TOKEN: CALL L1(R): IF TOKEN$ <> ")" THEN PRINT "MISMATCHED PARENTHESIS"
  65. 240 CALL GET.TOKEN: END SUB
  66.  
  67. 250 SUB PRIMITIVE (R) : IF TOK.TYPE = 2 THEN R = VAL(TOKEN$): CALL GET.TOKEN: EXIT SUB
  68. 260 PRINT "SYNTAX ERROR": END SUB
  69.  
  70. 340 SUB UNARY (O$, R)
  71. 350 IF O$ = "-" THEN R = -R
  72. 360 END SUB
  73.  
  74.