05-07-2008, 07:37 PM
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.
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