Turbo Toolbox/Turbo_Toolbox.iso/dtx9202/aripars/parsarit.pas

Pascal/Delphi Source File | 1991-01-29 | 6.0 KB | 331 lines

(* LISTING 1:  A program to parse and evaluate ordinary integer arithmetic expressions *)

(* This is a Texas Instruments-style calculator. It parses arithmetic expressions using*)
(* the usual precedence rules.*)
(* Written by Jonathan Amsterdam, December 1984; BYTE August 1985, S. 141-145*)


program TICalc;

    const
        endOfFile = 0;  (* special character signifying end of file *)
        empty = 127;  (* character used to indicate that savedChar is empty *)
        endOfLine = 13;  (* special character signifying end of line *)

    type
        nodetype = (binop, unop, number);
        node = ^noderec;
        noderec = record
                case tag : nodetype of
                    binop: (
                            operator: CHAR;
                            leftOperand, rightOperand: node
                    );
                    unop: (
                            uOperator: CHAR;
                            operand: node
                    );
                    number: (
                            num: INTEGER
                    );
            end;

    var
        savedChar: CHAR;
        digits: set of CHAR;


(* input functions *)

    function getChar: CHAR;
(*  Useful low-level character input. Returns special characters at end of file and end of line*)
        var
            c: CHAR;
    begin
        if savedCHAR <> chr(empty) then
            begin
                getCHAR := savedChar;
                savedChar := chr(empty);
            end
        else if eof then
            getChar := chr(endOfFile)
        else if eoln then
            begin
                getChar := chr(endOfLine);
                readln;
            end
        else
            begin
                read(c);
                getChar := c;
            end;
    end;


    procedure ungetChar (c: CHAR);
(* Allows one character at a time to be pushed back on the input. *)
    begin
        if savedChar = chr(empty) then
            savedChar := c
        else
            writeln('½½ungetChar½½ can½½t unget more than one character at a time ');
    end;


    function nextChar: CHAR;
(* Skips over blanks. *)
        var
            c: CHAR;
    begin
        repeat
            c := getChar
        until c <> ' ';
        nextChar := c;
    end;


    function charToInt (c: CHAR): INTEGER;
(* Converts a numeric character to an integer. *)
    begin
        if not (c in digits) then
            begin
                writeln('charToInt : ', c, 'is not a digit');
                charToInt := 0;
            end
        else
            charToint := ord(c) - ord('0');
    end;


    function getNum (c: CHAR): INTEGER;
(* Reads a number from the input. The first digit of the number has already been read *)
(*and is passed as an argument. *)
        var
            n: INTEGER;
    begin
        n := 0;
        repeat
            n := 10 * n + charToInt(c);
            c := getChar;
        until not (c in digits);
        ungetChar(c);
        getNum := n;
    end;


(*  node creation functions *)
(* The following three functions create nodes for the parse tree. The first*)
(*  two each return NIL if their node arguments are NIL. *)

    function binopNode (opor: CHAR; lopand, ropand: node): node;
        var
            n: node;
    begin
        if (lopand = nil) or (ropand = nil) then
            binopNode := nil
        else
            begin
                New(n, binop);
                with n^ do
                    begin
                        tag := binop;
                        operator := opor;
                        leftOperand := lopand;
                        rightOperand := ropand;
                    end;
                binopNode := n;
            end;
    end;


    function unopNode (opor: CHAR; opand: node): node;
        var
            n: node;
    begin
        if opand = nil then
            unopNode := nil
        else
            begin
                new(n, unop);
                with n^ do
                    begin
                        tag := unop;
                        uOperator := opor;
                        operand := opand;
                    end;
                unopNode := n;
            end;
    end;


    function numberNode (i: INTEGER): node;
        var
            n: node;
    begin
        new(n, number);
        with n^ do
            begin
                tag := number;
                num := i;
            end;
        numberNode := n;
    end;


(* tree-printing procedures *)

    procedure ptree (n: node; depth: integer);
    begin
        with n^ do
            case tag of
                binop:
                    begin
                        ptree(leftOperand, depth + 2);
                        writeln(' ' : depth, operator);
                        ptree(rightOperand, depth + 2);
                    end;
                unop:
                    begin
                        writeln(' ' : depth, uoperator);
                        ptree(operand, depth + 2);
                    end;
                number:
                    writeln(' ' : depth, num);
            end;
    end;


    procedure PrintTree (n: node);
    begin
        ptree(n, 0);
    end;


(* parser *)
(* Each of the three parsing functions returns NIL if an error occurs in the parse. *)

    function term: node;
    FORWARD;

    function factor: node;
    FORWARD;

    function expr: node;
(*  An expression is either a term, or a term +,- an expression. *)
        var
            c: CHAR;
            n: node;
    begin
        n := term;
        expr := n;
        if n <> nil then
            begin
                c := nextChar;
                if (c = '+') or (c = '-') then
                    expr := binopNode(c, n, expr)
                else if c <> chr(endOfLine) then
                    ungetChar(c);
            end;
    end;


    function term;(*:node*)
(*  A term is either a factor, or a factor *,/ a term. *)
        var
            c: CHAR;
            n: node;
    begin
        n := factor;
        term := n;
        if n <> nil then
            begin
                c := nextChar;
                if (c = '*') or (c = '/') then
                    term := binopNode(c, n, term)
                else
                    ungetChar(c);
            end;
    end;


    function factor;(*:node*)
(* A factor is either a number, or a - followed by a factor, or a parenthesized expression. *)
        var
            c: CHAR;
    begin
        c := nextChar;
        if c in digits then
            factor := numberNode(getNum(c))
        else if c = '-' then
            factor := unopNode(c, factor)
        else if c = '(' then
            begin
                factor := expr;
                if nextChar <> ')' then
                    writeln('close parenthesis expected');
            end
        else
            begin
                writeln('illegal expression');
                factor := nil;
            end;
    end;

    function eval (n: node): REAL;
(* Evaluates a parse tree. Assumes that the only binary operations are +, -, *,*)
(* and / and that the only unary operation is -. *)
        var
            op1, op2: REAL;
    begin
        with n^ do
            case tag of
                binop:
                    begin
                        op1 := eval(leftOperand);
                        op2 := eval(rightOperand);
                        case operator of
                            '+':
                                eval := op1 + op2;
                            '-':
                                eval := op1 - op2;
                            '*':
                                eval := op1 * op2;
                            '/':
                                eval := op1 / op2;
                        end;
                    end;
                unop:
                    eval := -eval(operand);
                number:
                    eval := num;
            end;
    end;


    procedure run;
        var
            n: node;
            c: CHAR;
    begin
        repeat
            write('> ');
            n := expr;
            if n <> nil then
                begin
                    writeln;
                    printTree(n);
                    writeln;
                    writeln(eval(n) : 0 : 2);
                end;
        until FALSE;
    end;


begin (*** MAIN PROGRAM ***)
    writeln('TI - style calculator');
    writeln('Enter an arithmetic expression and hit < RETURN >');
    writeln('I will print a parse tree and evaluate the expression .');
    digits := ['0'..'9'];
    run;
end.