Initial data commit

Task/Parsing-RPN-calculator-algorithm/ANSI-BASIC/parsing-rpn-calculator-algorithm.basic

@@ -0,0 +1,117 @@
+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