Mathematical expression translator

[yetifoot]

Hi all, stumbled across this challenge, it's right up my street!

Something I would say, is the rules and goals are not as clear as I'd like, should we be implementing everything that is possible in a QB expression?  What about things like / and \ which are different in C, you only have / and have to promote to float to cause an FP divide.  Are some things left-right or right-left? etc.

Anyway, that aside I put one together that seems to show most of what you want.  I prototyped it in FB, but it seems to work OK in the QB I have too.  It does the operator precedence (I hope..!, I'm not too sure on QB's exact precedence, and didn't fancy trial and erroring to find out, but i based it on FBs so it should be very close at least), has operators +, -, -(negate), /, \, *, ^, SQR, can deal with array or variables (arrays change to a[] syntax), it handles parenthesised sub expressions.  It might do some other stuff i forgot, or there may be features I implemented by accident when I added bugs

It is not optimal by a long shot, there are many things I could have done to it.  I could cut down the size of the code by rolling parseaddsub, parsemuldiv and others into one function, and using a table to control the operators.  I could have cut down on the strings.  I could have built a tree/stack from the expression in order to make it easy to optimize constants (ie (3 + 4) would become (7).  But I didn't.

Anyway, here's the code.

Code:

DECLARE FUNCTION parsenegate$ ()
DECLARE FUNCTION isdigit% (c AS INTEGER)
DECLARE FUNCTION isalpha% (c AS INTEGER)
DECLARE SUB skipwhite ()
DECLARE SUB readtoken ()
DECLARE FUNCTION parsefactor$ ()
DECLARE FUNCTION parsepow$ ()
DECLARE FUNCTION parsemuldiv$ ()
DECLARE FUNCTION parseidiv$ ()
DECLARE FUNCTION parseaddsub$ ()
DECLARE FUNCTION QB2C$ (s AS STRING)
DIM SHARED look AS INTEGER
DIM SHARED token AS STRING
DIM SHARED tokentype AS INTEGER
DIM SHARED buffer AS STRING
DIM SHARED bufferlen AS INTEGER
DIM SHARED bufferpos AS INTEGER

DECLARE SUB readchar ()
DECLARE FUNCTION parsetop$ ()

CONST TYPBAD = 0
CONST TYPOPERATOR = 1
CONST TYPNUMVAR = 2

'::::::::
' MAIN PROGRAM!

PRINT QB2C("((43 * 4) + 45 + 5 + 7 * 3 ^ 2) / 6 \ 3 + sqr( 54 - -4 ) + (--5) + B(54 + 3) - (-5) ^ 2")

'::::::::
FUNCTION isalpha% (c AS INTEGER)

    isalpha = ((c >= ASC("a")) AND (c <= ASC("z"))) OR ((c >= ASC("A")) AND (c <= ASC("Z")))

END FUNCTION

'::::::::
FUNCTION isdigit% (c AS INTEGER)

    isdigit = (c >= ASC("0")) AND (c <= ASC("9"))

END FUNCTION

'::::::::
FUNCTION parseaddsub$

    DIM l AS STRING
    DIM r AS STRING
    DIM op AS STRING

    l = parseidiv

    WHILE (token = "+") OR (token = "-")
        op = token
        readtoken
        r = parseidiv
        l = "(" + l + " " + op + " " + r + ")"
    WEND

    parseaddsub = l

END FUNCTION

'::::::::
FUNCTION parsefactor$

    DIM result$

    IF tokentype = TYPNUMVAR THEN
        result$ = token
        readtoken
        IF token = "(" THEN
            readtoken
            result$ = result$ + "[" + parsetop + "]"
            IF token <> ")" THEN
                PRINT "Expected parenthesis (4)"
                END
            END IF
            readtoken
        END IF
        parsefactor = result$
    ELSE
        IF token = "(" THEN
            readtoken
            parsefactor = parsetop
            IF token <> ")" THEN
                PRINT "Expected parenthesis (1)"
                END
            END IF
            readtoken
        ELSEIF UCASE$(token) = "SQR" THEN
            readtoken
            IF token = "(" THEN
                readtoken
                parsefactor = "sqrt(" + parsetop + ")"
                IF token <> ")" THEN
                    PRINT "Expected parenthesis (2)"
                    END
                END IF
                readtoken
            ELSE
                PRINT "Expected parenthesis (3)"
                END
            END IF
        ELSE
            PRINT "Bad factor: " + token
            END
        END IF
    END IF

END FUNCTION

'::::::::
FUNCTION parseidiv$

    DIM l AS STRING
    DIM r AS STRING
    DIM op AS STRING

    l = parsemuldiv

    WHILE (token = "\")
        op = token
        readtoken
        r = parsemuldiv
        l = "(" + l + " " + op + " " + r + ")"
    WEND

    parseidiv = l

END FUNCTION

'::::::::
FUNCTION parsemuldiv$

    DIM l AS STRING
    DIM r AS STRING
    DIM op AS STRING

    l = parsenegate

    WHILE (token = "*") OR (token = "/")
        op = token
        readtoken
        r = parsenegate
        l = "(" + l + " " + op + " " + r + ")"
    WEND

    parsemuldiv = l

END FUNCTION

'::::::::
FUNCTION parsenegate$

    DIM l AS STRING
    DIM r AS STRING

    IF token = "-" THEN
        readtoken
        r = parsetop
        l = "(-" + r + ")"
    ELSE
        l = parsepow
    END IF

    parsenegate = l

END FUNCTION

'::::::::
FUNCTION parsepow$

    DIM l AS STRING
    DIM r AS STRING

    l = parsefactor

    WHILE (token = "^")
        readtoken
        r = parsefactor
        l = "pow(" + l + ", " + r + ")"
    WEND

    parsepow = l

END FUNCTION

'::::::::
FUNCTION parsetop$

    parsetop = parseaddsub

END FUNCTION

'::::::::
FUNCTION QB2C$ (s AS STRING)

    buffer = s
    bufferlen = LEN(s)
    bufferpos = 0

    readchar
    readtoken

    QB2C = parsetop

    IF token <> "<<<EOF>>>" THEN
        PRINT "Something went wrong!"
        END
    END IF

END FUNCTION

'::::::::
SUB readchar

    IF bufferpos < bufferlen THEN
        look = ASC(MID$(buffer, bufferpos + 1, 1))
        bufferpos = bufferpos + 1
    ELSE
        look = -1
    END IF

END SUB

'::::::::
SUB readtoken

    skipwhite

    token = ""
    tokentype = TYPBAD

    IF (isdigit(look)) OR (look = ASC(".")) THEN
        WHILE (look <> -1) AND (isdigit(look) OR look = ASC("."))
            token = token + CHR$(look)
            readchar
        WEND
        tokentype = TYPNUMVAR
    ELSEIF isalpha(look) THEN
        WHILE (look <> -1) AND isalpha(look)
            token = token + CHR$(look)
            readchar
        WEND
        tokentype = TYPNUMVAR
        SELECT CASE UCASE$(token)
            CASE "SQR"
                tokentype = TYPOPERATOR
        END SELECT
    ELSE
        SELECT CASE look
            CASE ASC("+"), ASC("-"), ASC("\"), ASC("/"), ASC("*"), ASC("^"), ASC("("), ASC(")")
                token = CHR$(look)
                readchar
                tokentype = TYPOPERATOR
            CASE -1
                token = "<<<EOF>>>"
                tokentype = TYPBAD
            CASE ELSE
                PRINT "Bad character detected: '" + CHR$(look) + "'"
                END
        END SELECT
    END IF

    PRINT "token: '" + token + "'"

END SUB

'::::::::
SUB skipwhite

    WHILE (look <> -1) AND (look = ASC(" "))
        readchar
    WEND

END SUB