RosettaCodeData/Task/Parsing-RPN-calculator-algo.../ANSI-BASIC/parsing-rpn-calculator-algo...

118 lines
3.9 KiB
Plaintext

1000 DECLARE EXTERNAL SUB rpn
1010 PUBLIC NUMERIC R(64) ! stack
1020 PUBLIC STRING expn$ ! for keyboard input
1030 PUBLIC NUMERIC i, lenn, n, true, false ! global values
1040 LET true = -1
1050 LET false = 0
1060 DO
1070 PRINT "enter an RPN expression:"
1080 INPUT expn$
1090 IF LEN( expn$ ) = 0 THEN EXIT DO
1100 PRINT "expn: ";expn$
1110 CALL rpn( expn$ )
1120 LOOP
1130 END
1140 !
1150 ! interpret reverse polish (postfix) expression
1160 EXTERNAL SUB rpn( expn$ )
1170 DECLARE EXTERNAL FUNCTION is_digit, get_number
1180 DECLARE EXTERNAL SUB print_stack
1190 DECLARE STRING ch$
1200 LET expn$ = expn$ & " " ! must terminate line with space
1210 LET lenn = LEN( expn$ )
1220 LET i = 0
1230 LET n = 1
1240 LET R(n) = 0.0 ! push zero for unary operations
1250 DO
1260 IF i >= lenn THEN EXIT DO ! at end of line
1270 LET i = i + 1
1280 IF expn$(i:i) <> " " THEN ! skip white spaces
1290 IF is_digit( expn$(i:i) ) = true THEN ! push number onto stack
1300 LET n = n + 1
1310 LET R(n) = get_number
1320 CALL print_stack
1330 ELSEIF expn$(i:i) = "+" then ! add and pop stack
1340 IF n < 2 THEN
1350 PRINT "stack underflow"
1360 ELSE
1370 LET R(n-1) = R(n-1) + R(n)
1380 LET n = n - 1
1390 CALL print_stack
1400 END IF
1410 ELSEIF expn$(i:i) = "-" then ! subtract and pop stack
1420 IF n < 2 THEN
1430 PRINT "stack underflow"
1440 ELSE
1450 LET R(n-1) = R(n-1) - R(n)
1460 LET n = n - 1
1470 CALL print_stack
1480 END IF
1490 ELSEIF expn$(i:i) = "*" then ! multiply and pop stack
1500 IF n < 2 THEN
1510 PRINT "stack underflow"
1520 ELSE
1530 LET R(n-1) = R(n-1) * R(n)
1540 LET n = n - 1
1550 CALL print_stack
1560 END IF
1570 ELSEIF expn$(i:i) = "/" THEN ! divide and pop stack
1580 IF n < 2 THEN
1590 PRINT "stack underflow"
1600 ELSE
1610 LET R(n-1) = R(n-1) / R(n)
1620 LET n = n - 1
1630 CALL print_stack
1640 END IF
1650 ELSEIF expn$(i:i) = "^" THEN ! raise to power and pop stack
1660 IF n < 2 THEN
1670 PRINT "stack underflow"
1680 ELSE
1690 LET R(n-1) = R(n-1) ^ R(n)
1700 LET n = n - 1
1710 CALL print_stack
1720 END IF
1730 ELSE
1740 PRINT REPEAT$( " ", i+5 ); "^ error"
1750 EXIT DO
1760 END IF
1770 END IF
1780 LOOP
1790 PRINT "result: "; R(n) ! end of main program
1800 END SUB
1810 !
1820 ! extract a number from a string
1830 EXTERNAL FUNCTION get_number
1840 DECLARE EXTERNAL FUNCTION is_digit
1850 LET i1 = i ! start of number substring
1860 DO ! get integer part
1870 LET i = i + 1
1880 IF is_digit( expn$(i:i) ) = false THEN
1890 IF expn$(i:i) = "." THEN
1900 LET i = i + 1
1910 DO WHILE is_digit( expn$(i:i) ) = true ! get fractional part
1920 LET i = i + 1
1930 LOOP
1940 END IF
1950 EXIT DO
1960 END IF
1970 LOOP
1980 LET get_number = VAL( expn$(i1:i - 1) )
1990 END FUNCTION
2000 !
2010 ! check for digit character
2020 EXTERNAL FUNCTION is_digit( ch$ )
2030 IF "0" <= ch$ AND ch$ <= "9" THEN
2040 LET is_digit = true
2050 ELSE
2060 LET is_digit = false
2070 END IF
2080 END FUNCTION
2090 !
2100 EXTERNAL SUB print_stack
2110 PRINT expn$(i:i);" ";
2120 FOR ptr=n TO 2 STEP -1
2130 PRINT USING "-----%.####":R(ptr);
2140 NEXT ptr
2150 PRINT
2160 END SUB