QB64.org Forum

Active Forums => Programs => Topic started by: eoredson on July 23, 2017, 10:45:01 pm

Title: The Recursive Descent Parser
Post by: eoredson on July 23, 2017, 10:45:01 pm

Find attached What64 the recursive descent parser.

Erik.

Title: Re: The Recursive Descent Parser
Post by: bplus on July 24, 2017, 02:21:16 pm

Hi Erik,

Did you use this in your Interpreter SICK64D1.zip that I just downloaded?

Title: Re: The Recursive Descent Parser
Post by: STxAxTIC on July 24, 2017, 04:06:12 pm

Hey eoredson,

I've always liked this project. I'm glad you still occasionally make noise about it! Just curious - is there any formal website or home for this? Does the project *.zip contain all documentation?

And a really off-the-wall question is, just how much of the code is from the underscore-ridden QB64 era, vs how much is mostly QB45 compatible?

(I could dig a bit and answer all this myself, but I figure the public questions make things easier.)

Thanks!

Title: Re: The Recursive Descent Parser
Post by: eoredson on July 24, 2017, 08:30:13 pm

Thanks!

@bplus: Yes, it is the SICK engine.

STxAxTIC:
There is no web site I own that distributes it, and the .zip contains the entire project, including .doc

Interestingly enough, it was ported from 16-bit QB45 and that was not easy.

Unless https://goo.gl/pkQug8 qualifies as a web site..

Erik.

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 19, 2019, 06:55:54 am

SICK engine is large and filled with lot of stuff but i have have something smaller
well not written in qb64 but is quite universal ..
i hope that Mark(B+) can convert this to qb64...

Code: QB64: [Select]

1. 'recursive descent token evaluator
2. '#lookahead
3. int tc=0 : string token
4. string tokens[7]
5. tokens[1] = "2"
6. tokens[2] = "*"
7. tokens[3] = "("
8. tokens[4] = "3"
9. tokens[5] = "+"
10. tokens[6] = "4"
11. tokens[7] = ")"
12.  
13. sub gettok()
14. tc++ : token = tokens[tc]
15. end sub
16.  
17. sub expr() as float
18. float v = term()
19. if token = "+": gettok() : v = v + term(): end if
20. if token = "-": gettok() : v = v - term(): end if
21. return v
22. end sub
23.  
24. sub term() as float
25. float v = factor()
26. if token = "*": gettok() : v = v * factor(): end if
27. if token = "/": gettok() : v = v / factor(): end if
28. return v
29. end sub
30.  
31. sub factor() as float
32. float v
33. if asc(token)>47  and asc(token)<58 'nums
34. v = val(token) : gettok()
35. end if
36. if asc(token)=40 and asc(token)<>41 'match (...)
37. gettok() : v = expr() : gettok()
38. end if
39. return v
40. end sub
41.  
42. 'execute---------------
43. gettok() 'start
44. float res = expr()
45. print str res

Title: Re: The Recursive Descent Parser
Post by: odin on March 19, 2019, 08:09:04 am

Posting code that's unusable in QB64 is not welcome. If the idea is awesome, adapt it to QB64 and post it or else just post it under off-topic.

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 19, 2019, 08:52:51 am

sorry i know that...
but i simply don't know how to translate this code to qb64.
I use Davs IDE .
main problem i have is with SUB routines
in another words i cannot figured proper shape..
i am looking into help of qb64 but i simply cannot found where is what?

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 19, 2019, 09:02:19 am

Here is what i transform but some things are wrong

Code: QB64: [Select]

1. recursive descent token evaluator
2. '
3. dim tc as INTEGER : dim token as string : dim v as single
4. DIM tokens() as string * 7
5. tokens(1) = "2"
6. tokens(2) = "*"
7. tokens(3) = "("
8. tokens(4) = "3"
9. tokens(5) = "+"
10. tokens(6) = "4"
11. tokens(7) = ")"
12.  
13. sub gettok()
14. tc=tc+1 : token = tokens(tc)
15. end sub
16.  
17. sub expr()
18. v = term()
19. if token = "+": gettok() : v = v + term(): end if
20. if token = "-": gettok() : v = v - term(): end if
21. return v
22. end sub
23.  
24. sub term()
25. v = factor()
26. if token = "*": gettok() : v = v * factor(): end if
27. if token = "/": gettok() : v = v / factor(): end if
28. return v
29. end sub
30.  
31. sub factor()
32. if asc(token)>47  and asc(token)<58 'nums
33. v = val(token) : gettok()
34. end if
35. if asc(token)=40 and asc(token)<>41 'match (...)
36. gettok() : v = expr() : gettok()
37. end if
38. return v
39. end sub
40.  
41. 'execute---------------
42. gettok() 'start
43. float res = expr()
44. print str(res)

Title: Re: The Recursive Descent Parser
Post by: _vince on March 19, 2019, 09:17:06 am

What language is it? It looks interesting

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 19, 2019, 10:08:29 am

hi vince
it is o2( Oxygen basic)
all basic dialects are very similar and that is good
but i simply stuck with such a simple code here in qb64 ..my fault
or i become rusty .. :)

Title: Re: The Recursive Descent Parser
Post by: jack on March 19, 2019, 10:23:56 am

Hi Aurel
here's your code translated to QB64

Code: QB64: [Select]

1. 'recursive descent token evaluator
2. DIM SHARED tc AS LONG
3. DIM SHARED tokens(8) AS STRING * 1
4. DIM SHARED token AS STRING
5.  
6. tc = 0
7. tokens(1) = "2"
8. tokens(2) = "*"
9. tokens(3) = "("
10. tokens(4) = "3"
11. tokens(5) = "+"
12. tokens(6) = "4"
13. tokens(7) = ")"
14.  
15. 'execute---------------
16. CALL gettok 'start
17. DIM res AS DOUBLE
18. res = expr#
19. PRINT res
20. END
21.  
22. SUB gettok ()
23.     tc = tc + 1
24.     token = tokens(tc)
25. END SUB
26.  
27. FUNCTION expr# ()
28.     DIM v AS DOUBLE
29.     v = term#
30.     IF token = "+" THEN
31.         gettok
32.         v = v + term#
33.     END IF
34.     IF token = "-" THEN
35.         gettok
36.         v = v - term#
37.     END IF
38.     expr# = v
39. END FUNCTION
40.  
41. FUNCTION term# ()
42.     DIM v AS DOUBLE
43.     v = factor#
44.     IF token = "*" THEN
45.         gettok
46.         v = v * factor#
47.     END IF
48.     IF token = "/" THEN
49.         gettok
50.         v = v / factor#
51.     END IF
52.     term# = v
53. END FUNCTION
54.  
55. FUNCTION factor# ()
56.     DIM v AS DOUBLE
57.     IF ASC(token) > 47 AND ASC(token) < 58 THEN 'nums
58.         v = VAL(token)
59.         gettok
60.     END IF
61.     IF ASC(token) = 40 AND ASC(token) <> 41 THEN 'match (...)
62.         gettok
63.         v = expr#
64.         gettok
65.     END IF
66.     factor# = v
67. END FUNCTION
68.  

output 14

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 19, 2019, 10:31:21 am

hi Jack and thank you!
now i see where is difference.
qb require # suffix for floating point number
globals need directive SHERED...
nice !

As we can see this few functions are really simple.

Title: Re: The Recursive Descent Parser
Post by: bplus on March 19, 2019, 10:53:41 am

Quote from: Aurel on March 19, 2019, 10:31:21 am

hi Jack and thank you!
now i see where is difference.
qb require # suffix for floating point number
globals need directive SHERED...
nice !

As we can see this few functions are really simple.

Aurel something else about QB64 subs and functions you should know:
The arguments passed are by default By Reference, NOT By Value so if you change a value in sub it might go back to main program changed.

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 19, 2019, 11:22:27 am

Hey Mark
I see now that something is different ..
ok so default is byRef...mean pointered.

Title: Re: The Recursive Descent Parser
Post by: jack on March 19, 2019, 11:28:01 am

@Aurel
in your function factor the second if clause makes no sense, you can replace it with else, '(' and ')' are simply ignored by the function expr

Code: QB64: [Select]

1. FUNCTION factor# ()
2.     DIM v AS DOUBLE
3.     IF ASC(token) > 47 AND ASC(token) < 58 THEN 'nums
4.         v = VAL(token)
5.         gettok
6.     ELSE
7.         gettok
8.         v = expr#
9.         gettok
10.     END IF
11.     factor# = v
12. END FUNCTION
13.  

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 19, 2019, 11:36:50 am

hi jack
Yes you have right IF we use this program as finished or completed
but if you wish to add more operation under factor() function then makes no sense to use
ELSE...
so probably should be better to use ELSEIF method
but that is another story.
In fact match just operate under parens () in another word if parens exists.
hmmm is that ok ?

Title: Re: The Recursive Descent Parser
Post by: Ed Davis on March 19, 2019, 12:09:06 pm

Quote from: Aurel on March 19, 2019, 10:31:21 am

As we can see this few functions are really simple.

Try this expression: 1+2+3

The answer should be 6, but the evaluator returns 3.  I think recursion in qb64 is broken.

Hmmm.  Searching old messages, only broken if 0 arguments.  I changed expr# and term# to take a single argument, changed the calls to the same, and now it works fine.

Will this be fixed one day, or is it for backwards compatibility or something and thus will remain as it is?

Title: Re: The Recursive Descent Parser
Post by: jack on March 19, 2019, 12:51:19 pm

@Ed Davis
would you post the code please?

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 19, 2019, 01:26:50 pm

Quote

I think recursion in qb64 is broken

no ..is not
it is problem in evaluator because i get same error in o2 version ..too
I don't understand exatly what you mean under single argument?

Title: Re: The Recursive Descent Parser
Post by: SMcNeill on March 19, 2019, 01:57:55 pm

Quote from: Aurel on March 19, 2019, 01:26:50 pm

Quote

I think recursion in qb64 is broken

no ..is not
it is problem in evaluator because i get same error in o2 version ..too
I don't understand exatly what you mean under single argument?

Read the issue and a fix here: https://www.qb64.org/forum/index.php?topic=704.msg5802#msg5802

Basically, the following is broken:

Code: QB64: [Select]

1. DIM SHARED X
2. X = 5
3. PRINT F
4.  
5. FUNCTION F
6. IF X = 0 THEN F = 1 ELSE PRINT "*": X = X - 1: F = F
7. END FUNCTIOn

Luke was going to try and sort out a solution to the issue in the evaltype routine, but has been busy with life in general and hasn’t gotten around to it yet.  If you use zero-argument recursion a lot, you might want to apply my patch to QB64.bas and recompile the EXE.  If not, and it’s a once-in-a-bluemoon issue, just pass a dummy parameter to the function.

Instead of:

FUNCTION foo
   Foo = foo
END FUNCTION

Use:

Function Foo (dummy)
   Foo = Foo (Whatever)
END FUNCTION

Title: Re: The Recursive Descent Parser
Post by: Ed Davis on March 19, 2019, 02:01:28 pm

Quote from: Aurel on March 19, 2019, 01:26:50 pm

Quote

I think recursion in qb64 is broken

no ..is not
it is problem in evaluator because i get same error in o2 version ..too
I don't understand exatly what you mean under single argument?

Original version, but with a different expression - should show 6, but it shows 3:

Code: QB64: [Select]

1. 'recursive descent token evaluator - original version
2. DIM SHARED tc AS LONG
3. DIM SHARED tokens(8) AS STRING * 1
4. DIM SHARED token AS STRING
5.  
6. tc = 0
7. tokens(1) = "1"
8. tokens(2) = "+"
9. tokens(3) = "2"
10. tokens(4) = "+"
11. tokens(5) = "3"
12.  
13. 'execute---------------
14. CALL gettok 'start
15. DIM res AS DOUBLE
16. res = expr#
17. PRINT res
18. END
19.  
20. SUB gettok ()
21.     tc = tc + 1
22.     token = tokens(tc)
23. END SUB
24.  
25. FUNCTION expr# ()
26.     DIM v AS DOUBLE
27.     v = term#
28.     IF token = "+" THEN
29.         gettok
30.         v = v + term#
31.     END IF
32.     IF token = "-" THEN
33.         gettok
34.         v = v - term#
35.     END IF
36.     expr# = v
37. END FUNCTION
38.  
39. FUNCTION term# ()
40.     DIM v AS DOUBLE
41.     v = factor#
42.     IF token = "*" THEN
43.         gettok
44.         v = v * factor#
45.     END IF
46.     IF token = "/" THEN
47.         gettok
48.         v = v / factor#
49.     END IF
50.     term# = v
51. END FUNCTION
52.  
53. FUNCTION factor# ()
54.     DIM v AS DOUBLE
55.     IF ASC(token) > 47 AND ASC(token) < 58 THEN 'nums
56.         v = VAL(token)
57.         gettok
58.     END IF
59.     IF ASC(token) = 40 AND ASC(token) <> 41 THEN 'match (...)
60.         gettok
61.         v = expr#
62.         gettok
63.     END IF
64.     factor# = v
65. END FUNCTION
66.  

Updated version, but using one (dummy) argument for expr and term - gets the right answer:

Code: QB64: [Select]

1. 'recursive descent token evaluator - added dummy arguments
2. DIM SHARED tc AS LONG
3. DIM SHARED tokens(8) AS STRING * 1
4. DIM SHARED token AS STRING
5.  
6. tc = 0
7. tokens(1) = "1"
8. tokens(2) = "+"
9. tokens(3) = "2"
10. tokens(4) = "+"
11. tokens(5) = "3"
12.  
13. 'execute---------------
14. CALL gettok 'start
15. DIM res AS DOUBLE
16. res = expr#(0)
17. PRINT res
18. END
19.  
20. SUB gettok ()
21.     tc = tc + 1
22.     token = tokens(tc)
23. END SUB
24.  
25. FUNCTION expr# (x as integer)
26.     DIM v AS DOUBLE
27.     v = term#(0)
28.     IF token = "+" THEN
29.         gettok
30.         v = v + expr#(0)
31.     ELSEIF token = "-" THEN
32.         gettok
33.         v = v - expr#(0)
34.     END IF
35.     expr# = v
36. END FUNCTION
37.  
38. FUNCTION term# (x as integer)
39.     DIM v AS DOUBLE
40.     v = factor#
41.     IF token = "*" THEN
42.         gettok
43.         v = v * term#(0)
44.     ELSEIF token = "/" THEN
45.         gettok
46.         v = v / term#(0)
47.     END IF
48.     term# = v
49. END FUNCTION
50.  
51. FUNCTION factor# ()
52.     DIM v AS DOUBLE
53.     IF ASC(token) > 47 AND ASC(token) < 58 THEN 'nums
54.         v = VAL(token)
55.         gettok
56.     ELSEIF ASC(token) = 40 AND ASC(token) <> 41 THEN 'match (...)
57.         gettok
58.         v = expr#(0)
59.         gettok
60.     END IF
61.     factor# = v
62. END FUNCTION
63.  

See this message: https://www.qb64.org/forum/index.php?topic=676.msg5776#msg5776
for a confirmation of the recursion bug.

Interestingly, FreeBasic, in QB mode, also has the same problem.  However, when compiled in normal FreeBasic mode (some minor changes have to be made to the code), it works fine.

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 19, 2019, 03:04:58 pm

Hmm that is interesting and as i said same problem i found in o2 version
I don't look first time what was going on using token one by one (in each step)
then when i look again into my old interpretr i figured that i use
while loop with operators +,-,*,/
so probably this loop add one turn more for "dummy" effect and
now everything work as it should be .
strange thing ..i must try with null too...

Title: Re: The Recursive Descent Parser
Post by: bplus on March 20, 2019, 10:14:36 am

I don't think you guys have it fixed yet:

Code: QB64: [Select]

1. _TITLE "Recursive descent token evaluator by Aurel"
2. 'trenslation by @jack 19.3.2019
3. ' nope! now use Ed Davis fix: https://www.qb64.org/forum/index.php?topic=33.15
4. 'mod by B+ 2019-03-20 so that can test any number of expressions
5.  
6. DIM SHARED tc AS LONG
7. DIM SHARED token AS STRING
8. DIM res AS DOUBLE
9. 'tc = 0
10. 'tokens(1) = "2"
11. 'tokens(2) = "*"
12. 'tokens(3) = "("
13. 'tokens(4) = "3"
14. 'tokens(5) = "+"
15. 'tokens(6) = "4"
16. 'tokens(7) = ")"
17.  
18. DO
19.     INPUT "Enter an expression to evaluate: ", eval$
20.     le = LEN(eval$)
21.     IF le THEN
22.         tc = 0
23.         REDIM SHARED tokens(1 TO le + 1) AS STRING * 1
24.         FOR i = 1 TO le
25.             tokens(i) = MID$(eval$, i, 1)
26.         NEXT
27.         'execute---------------
28.         'CALL gettok 'start
29.         gettok
30.         res = expr#(0)
31.         PRINT res
32.     END IF
33. LOOP UNTIL le = 0
34.  
35. 'recursive descent token evaluator - added dummy arguments  (fixed set? by Ed Davis)
36. SUB gettok ()
37.     tc = tc + 1
38.     token = tokens(tc)
39. END SUB
40.  
41. FUNCTION expr# (x AS INTEGER)
42.     DIM v AS DOUBLE
43.     v = term#(0)
44.     IF token = "+" THEN
45.         gettok
46.         v = v + expr#(0)
47.     ELSEIF token = "-" THEN
48.         gettok
49.         v = v - expr#(0)
50.     END IF
51.     expr# = v
52. END FUNCTION
53.  
54. FUNCTION term# (x AS INTEGER)
55.     DIM v AS DOUBLE
56.     v = factor#
57.     IF token = "*" THEN
58.         gettok
59.         v = v * term#(0)
60.     ELSEIF token = "/" THEN
61.         gettok
62.         v = v / term#(0)
63.     END IF
64.     term# = v
65. END FUNCTION
66.  
67. FUNCTION factor# ()
68.     DIM v AS DOUBLE
69.     IF ASC(token) > 47 AND ASC(token) < 58 THEN 'nums
70.         v = VAL(token)
71.         gettok
72.     ELSEIF ASC(token) = 40 AND ASC(token) <> 41 THEN 'match (...)
73.         gettok
74.         v = expr#(0)
75.         gettok
76.     END IF
77.     factor# = v
78. END FUNCTION
79.  
80.  

Wait this was limited to only single digits? :P

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 20, 2019, 10:31:28 am

Quote

Wait this was limited to only single digits?

No i think NOT limited to one digit.
token should use any number like "12345"
First i will check again o2 version then i try fix qb64 version ok?

Title: Re: The Recursive Descent Parser
Post by: Ed Davis on March 20, 2019, 10:38:07 am

Quote from: bplus on March 20, 2019, 10:14:36 am

I don't think you guys have it fixed yet:

Wait this was limited to only single digits? :P

Correct.  There isn't a real scanner - it just assumes single characters, no spaces allowed.  I guess Aurel posted it to "get his feet wet" with QB64?  So it is at best a simple demo, nothing more.

I like your colors, by the way!

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 20, 2019, 11:26:03 am

In another words
if we wish to enter expression and evaluate it , we need TOKENIZER
to split our expression into tokens( read numbers & operators )
is that ok.

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 20, 2019, 12:14:14 pm

well i tryed  this without dummy load and with additional while loop
like i do in o2 but nothing ...
token taken are
1
+
2
  0

Title: Re: The Recursive Descent Parser
Post by: bplus on March 20, 2019, 12:32:03 pm

Aurel your attempts here have me skimming over Erik's massive and successful undertaking and having me appreciate all over again Erik's effort. :)

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 20, 2019, 01:59:57 pm

Yes Mark
Erik really do big work with his SICK engine ...
and is not very easy to follow all what he do in it.
It is great but little bit too complex for me.
He use large amount of string processing which confuses me..
of course i understand them all but as i said is not easy to get what is what(for me
even i have experience in that things)- of course not like Ed ;)

Title: Re: The Recursive Descent Parser
Post by: Aurel on March 21, 2019, 10:55:50 am

Hi..
I just forund in my old programs one created by author of qb64
i called that program GALEON BASIC.
This program is posted on old forum ..long time ago.
There is a interesting way used for evaluating expression with GOTO command..
so can i publish it here ?

Title: Re: The Recursive Descent Parser
Post by: Ed Davis on March 29, 2019, 04:27:56 pm

Here are a couple of numeric expression parsers I wrote a while back.  Both use all QB64 numeric/logical/boolean operators along with standard Basic precedence, as noted in the Microsoft BASIC manuals, namely:

Code: QB64: [Select]

1. Operator Precedence in BASIC
2.  
3. Highest:   ^
4.            + - (unary negation)
5.            *  /
6.            \ (integer division)
7.           MOD
8.            +  -
9.            =  <>  <  >  <=  >=
10.           NOT (unary)
11.           AND
12.           OR
13.           XOR
14.           EQV
15. Lowest:   IMP
16.  

The first uses a form of Recursive Descent called Precedence Climbing, which I find easier than traditional Recursive Descent.  The second uses traditional Recursive Descent.  Both support the operators listed above, along with the following functions: abs, atn, cos, exp, fix, int, log, rnd, sgn, sin, sqr, tan.

Hopefully, the code is easy enough to follow.  Feedback is of course appreciated.

Expression Parser using Precedence Climbing:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2.  
3. $screenhide
4. $console
5. _console on
6. _dest _console
7.  
8. 'Simple numeric calculator - uses BASIC precedence rules
9. '
10. 'Supports all QB numeric/logical operators, plus the following functions:
11. '
12. 'abs, atn, cos, exp, fix, int, log, rnd, sgn, sin, sqr, tan
13. '
14. 'Uses Precedence Climbing algorithm
15. '
16. 'Operator Precedence in BASIC
17. '
18. 'Highest:   ^
19. '           + - (unary negation)
20. '           *  /
21. '           \ (integer division)
22. '          MOD
23. '           +  -
24. '           =  <>  <  >  <=  >=
25. '          NOT (unary)
26. '          AND
27. '          OR
28. '          XOR
29. '          EQV
30. 'Lowest:   IMP
31. '
32.  
33. dim shared input_st as string   'the string to evaluate
34.  
35. dim shared tok as integer       ' set by the scanner - one of the values listed below
36. dim shared id_name as string    ' set by the scanner, if tok is an ID or NUMBER
37.  
38. dim shared prec(20) as integer  'array of precedences
39.  
40. CONST false = 0
41. CONST true = not false
42.  
43. ' Values for tok - also indexes into prec array - code below depends on this ordering
44. const POWER     =   1
45. const NEGATE    =   2
46. const MULTIPLY  =   3
47. const DIVIDE    =   4
48. const INT_DIV   =   5
49. const MODULUS   =   6
50. const ADD       =   7
51. const SUBTRACT  =   8
52. const EQUAL     =   9
53. const NOT_EQUAL =  10
54. const LSS_T     =  11
55. const GTR_T     =  12
56. const LSS_T_EQL =  13
57. const GTR_T_EQL =  14
58. const NOT_T     =  15
59. const AND_T     =  16
60. const OR_T      =  17
61. const XOR_T     =  18
62. const EQV_T     =  19
63. const IMP_T     =  20
64.  
65. const ID        = 100
66. const NUMBER    = 101
67. const LPAREN    = 102
68. const RPAREN    = 103
69.  
70. ' populate the precedence array - these conicide with the constants above
71. ' we use the operator constants (above) as indexes into the precedence array
72. '
73. prec(POWER)    = 13
74. prec(NEGATE)   = 12
75. prec(DIVIDE)   = 11: prec(MULTIPLY) = 11
76. prec(INT_DIV)  = 10
77. prec(MODULUS)  = 9
78. prec(SUBTRACT) = 8: prec(ADD) = 8
79. prec(GTR_T_EQL)=7:prec(LSS_T_EQL)=7:prec(GTR_T)=7:prec(LSS_T)=7:prec(NOT_EQUAL)=7:prec(EQUAL)=7
80. prec(NOT_T)    = 6
81. prec(AND_T)    = 5
82. prec(OR_T)     = 4
83. prec(XOR_T)    = 3
84. prec(EQV_T)    = 2
85. prec(IMP_T)    = 1
86.  
87. input_st = "-1 - 2 - 3 - 4"
88. print input_st + " = "; eval#
89.  
90. input_st = "3 + 6 / 12 * 3 - 2"
91. print input_st + " = "; eval#
92.  
93. input_st = "4 ^ - 2"
94. print input_st + " = "; eval#
95.  
96. input_st = "4 ^ 3 ^ 2"
97. print input_st + " = "; eval#
98.  
99. input_st = "32 / 2 / 2"
100. print input_st + " = "; eval#
101.  
102. input_st = "atn(1) * 4"
103. print "PI = " + input_st + " = "; eval#
104.  
105. while 1
106.     input "Enter a string to evaluate > "; input_st
107.     if input_st = "" then end
108.     print "Expression = "; eval#
109.     ?
110. wend
111.  
112. function eval#
113.     next_tok
114.     eval# = evalr#(0)
115. end function
116.  
117. function evalr#(pr as integer)
118.     dim n as double
119.  
120.     n = primary#
121.  
122.     do while is_binary%(tok) 'need short circuit for this: and prec(tok) >= pr
123.         if prec(tok) < pr then exit do
124.         dim op as integer
125.         op = tok
126.         next_tok
127.         select case op
128.             case IMP_T     : n = n imp evalr#(prec(op) + 1)
129.             case EQV_T     : n = n eqv evalr#(prec(op) + 1)
130.             case XOR_T     : n = n xor evalr#(prec(op) + 1)
131.             case OR_T      : n = n or  evalr#(prec(op) + 1)
132.             case AND_T     : n = n and evalr#(prec(op) + 1)
133.             case GTR_T     : n = n >   evalr#(prec(op) + 1)
134.             case GTR_T_EQL : n = n >=  evalr#(prec(op) + 1)
135.             case LSS_T_EQL : n = n <=  evalr#(prec(op) + 1)
136.             case LSS_T     : n = n <   evalr#(prec(op) + 1)
137.             case NOT_EQUAL : n = n <>  evalr#(prec(op) + 1)
138.             case EQUAL     : n = n =   evalr#(prec(op) + 1)
139.             case SUBTRACT  : n = n -   evalr#(prec(op) + 1)
140.             case ADD       : n = n +   evalr#(prec(op) + 1)
141.             case MODULUS   : n = n mod evalr#(prec(op) + 1)
142.             case INT_DIV   : n = n \   evalr#(prec(op) + 1)
143.             case DIVIDE    : n = n /   evalr#(prec(op) + 1)
144.             case MULTIPLY  : n = n *   evalr#(prec(op) + 1)
145.             case POWER     : n = n ^   evalr#(prec(op) + 1)
146.             case else: print "Expecting an binary operator": evalr# = 0: exit do
147.         end select
148.         if is_relational(op) and is_relational(tok) then
149.             print "consecutive relational operators not allowed"
150.             evalr# = 0
151.         end if
152.     loop
153.     evalr# = n
154. end function
155.  
156. function is_binary%(op as integer)
157.     is_binary% = false
158.     if op >= MULTIPLY and op <= IMP_T then is_binary% = true: exit function
159.     if op = POWER then is_binary% = true: exit function
160. end function
161.  
162. function is_relational%(op as integer)
163.     is_relational% = false
164.     if op >= EQUAL and op <= GTR_T_EQL then is_relational% = true
165. end function
166.  
167. function primary#
168.     dim n as double
169.     dim fun as string
170.  
171.     select case tok
172.         case NUMBER:   n = val(id_name): next_tok
173.         case ADD:      next_tok: n =     evalr#(prec(NEGATE))
174.         case SUBTRACT: next_tok: n =    -evalr#(prec(NEGATE))
175.         case NOT_T:    next_tok: n = not evalr#(prec(NOT_T))
176.         case LPAREN
177.             next_tok
178.             n = evalr#(0)
179.             call expect(RPAREN, ")")
180.         case ID
181.             fun = id_name
182.             next_tok
183.             call expect(LPAREN, "(")
184.             n = evalr#(0)
185.             call expect(RPAREN, ")")
186.             n = builtin(fun, n)
187.         case else: print "Expecting a primary": n = 0
188.     end select
189.     primary# = n
190. end function
191.  
192. function builtin#(fun as string, arg as double)
193.     dim n as double
194.  
195.     select case lcase$(fun)
196.         case "abs": n = abs(arg)
197.         case "atn": n = atn(arg)
198.         case "cos": n = cos(arg)
199.         case "exp": n = exp(arg)
200.         case "fix": n = fix(arg)
201.         case "int": n = int(arg)
202.         case "log": n = log(arg)
203.         case "rnd": n = rnd(arg)
204.         case "sgn": n = sgn(arg)
205.         case "sin": n = sin(arg)
206.         case "sqr": n = sqr(arg)
207.         case "tan": n = tan(arg)
208.         case else: n = 0: print "Expecting a function, found: "; fun
209.     end select
210.     builtin# = n
211. end function
212.  
213. sub expect(n as integer, s as string)
214.     if tok = n then next_tok: exit sub
215.     print "Expecting: "; s
216. end sub
217.  
218. sub next_tok
219.     id_name = ""
220.     tok = 0
221.  
222.     ' skip spaces
223.     input_st = ltrim$(input_st)
224.  
225.     if input_st = "" then exit sub
226.  
227.     ' pick off a few multichar operators
228.     select case lcase$(left$(input_st, 2))
229.         case ">=": input_st = mid$(input_st, 3): tok = GTR_T_EQL
230.         case "<=": input_st = mid$(input_st, 3): tok = LSS_T_EQL
231.         case "<>": input_st = mid$(input_st, 3): tok = NOT_EQUAL
232.         case else
233.             ' now do the rest, based on first letter
234.         select case lcase$(left$(input_st, 1))
235.             case "0" to "9"
236.                 do
237.                     id_name = id_name + left$(input_st, 1)
238.                     input_st = mid$(input_st, 2)
239.                 loop while (left$(input_st, 1) >= "0" and left$(input_st, 1) <= "9") or left$(input_st, 1) = "."
240.                 tok = NUMBER
241.             case "a" to "z"
242.                 do
243.                     id_name = id_name + left$(input_st, 1)
244.                     input_st = mid$(input_st, 2)
245.                 loop while left$(input_st, 1) >= "a" and left$(input_st, 1) <= "z"
246.                 select case lcase$(id_name)
247.                     case "mod": tok = MODULUS:
248.                     case "not": tok = NOT_T:
249.                     case "and": tok = AND_T:
250.                     case "or" : tok = OR_T:
251.                     case "eqv": tok = EQV_T:
252.                     case "imp": tok = IMP_T:
253.                     case "xor": tok = XOR_T:
254.                     case else:  tok = ID:
255.                 end select
256.  
257.             case "^": input_st = mid$(input_st, 2): tok = POWER
258.             case "*": input_st = mid$(input_st, 2): tok = MULTIPLY
259.             case "/": input_st = mid$(input_st, 2): tok = DIVIDE
260.             case "\": input_st = mid$(input_st, 2): tok = INT_DIV
261.             case "+": input_st = mid$(input_st, 2): tok = ADD
262.             case "-": input_st = mid$(input_st, 2): tok = SUBTRACT
263.             case "=": input_st = mid$(input_st, 2): tok = EQUAL
264.             case "(": input_st = mid$(input_st, 2): tok = LPAREN
265.             case ")": input_st = mid$(input_st, 2): tok = RPAREN
266.             case ">": input_st = mid$(input_st, 2): tok = GTR_T
267.             case "<": input_st = mid$(input_st, 2): tok = LSS_T
268.             case else: print "Unknown token encountered"
269.         end select
270.     end select
271. end sub
272.  

Expression Parser using Recursive Descent:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2.  
3. $screenhide
4. $console
5. _console on
6. _dest _console
7.  
8. 'Simple numeric calculator - uses BASIC precedence rules
9. '
10. 'Supports all QB numeric/logical operators, plus the following functions:
11. '
12. 'abs, atn, cos, exp, fix, int, log, rnd, sgn, sin, sqr, tan
13. '
14. 'Uses Recursive Descent algorithm
15. 'This requires one function per precedence level
16. '
17. 'Operator Precedence in BASIC
18. '
19. 'Highest:   ^
20. '           + - (unary negation)
21. '           *  /
22. '           \ (integer division)
23. '          MOD
24. '           +  -
25. '           =  <>  <  >  <=  >=
26. '          NOT (unary)
27. '          AND
28. '          OR
29. '          XOR
30. '          EQV
31. 'Lowest:   IMP
32.  
33. dim shared input_st as string   'the string to evaluate
34.  
35. dim shared tok as integer       ' set by the scanner - one of the values listed below
36. dim shared id_name as string    ' set by the scanner, if tok is an ID or NUMBER
37.  
38. CONST false = 0
39. CONST true = not false
40.  
41. ' Values for tok
42. const POWER     =   1
43. const NEGATE    =   2
44. const MULTIPLY  =   3
45. const DIVIDE    =   4
46. const INT_DIV   =   5
47. const MODULUS   =   6
48. const ADD       =   7
49. const SUBTRACT  =   8
50. const EQUAL     =   9
51. const NOT_EQUAL =  10
52. const LSS_T     =  11
53. const GTR_T     =  12
54. const LSS_T_EQL =  13
55. const GTR_T_EQL =  14
56. const NOT_T     =  15
57. const AND_T     =  16
58. const OR_T      =  17
59. const XOR_T     =  18
60. const EQV_T     =  19
61. const IMP_T     =  20
62.  
63. const ID        = 100
64. const NUMBER    = 101
65. const LPAREN    = 102
66. const RPAREN    = 103
67.  
68. input_st = "-1 - 2 - 3 - 4"
69. print input_st + " = "; eval#
70.  
71. input_st = "3 + 6 / 12 * 3 - 2"
72. print input_st + " = "; eval#
73.  
74. input_st = "4 ^ - 2"
75. print input_st + " = "; eval#
76.  
77. input_st = "4 ^ 3 ^ 2"
78. print input_st + " = "; eval#
79.  
80. input_st = "32 / 2 / 2"
81. print input_st + " = "; eval#
82.  
83. input_st = "atn(1) * 4"
84. print "PI = " + input_st + " = "; eval#
85.  
86. while 1
87.     input "Enter a string to evaluate > "; input_st
88.     if input_st = "" then end
89.     print "Expression = "; eval#
90.     ?
91. wend
92.  
93. function eval#
94.     next_tok
95.     eval# = evalr#(0)
96. end function
97.  
98. function evalr#(dummy)
99.     dim n as double
100.  
101.     n = eval_eqv#(0)
102.     do while tok = IMP_T
103.         next_tok: n = n imp eval_eqv#(0)
104.     loop
105.     evalr# = n
106. end function
107.  
108. function eval_eqv#(dummy)
109.     dim n as double
110.  
111.     n = eval_xor#(0)
112.     do while tok = EQV_T
113.         next_tok: n = n eqv eval_xor#(0)
114.     loop
115.     eval_eqv# = n
116. end function
117.  
118. function eval_xor#(dummy)
119.     dim n as double
120.  
121.     n = eval_or#(0)
122.     do while tok = XOR_T
123.         next_tok: n = n xor eval_or#(0)
124.     loop
125.     eval_xor# = n
126. end function
127.  
128. function eval_or#(dummy)
129.     dim n as double
130.  
131.     n = eval_and#(0)
132.     do while tok = OR_T
133.         next_tok: n = n or eval_and#(0)
134.     loop
135.     eval_or# = n
136. end function
137.  
138. function eval_and#(dummy)
139.     dim n as double
140.  
141.     n = eval_relational#(0)
142.     do while tok = AND_T
143.         next_tok: n = n and eval_relational#(0)
144.     loop
145.     eval_and# = n
146. end function
147.  
148. function eval_relational#(dummy)
149.     dim n as double
150.  
151.     n = eval_add#(0)
152.     select case tok
153.         case GTR_T    : next_tok: n = n >  eval_add#(0)
154.         case GTR_T_EQL: next_tok: n = n >= eval_add#(0)
155.         case LSS_T_EQL: next_tok: n = n <= eval_add#(0)
156.         case LSS_T    : next_tok: n = n <  eval_add#(0)
157.         case NOT_EQUAL: next_tok: n = n <> eval_add#(0)
158.         case EQUAL    : next_tok: n = n =  eval_add#(0)
159.     end select
160.     eval_relational# = n
161. end function
162.  
163. function eval_add#(dummy)
164.     dim n as double
165.  
166.     n = eval_mod#(0)
167.     do
168.         select case tok
169.             case ADD:      next_tok: n = n + eval_mod#(0)
170.             case SUBTRACT: next_tok: n = n - eval_mod#(0)
171.             case else: exit do
172.         end select
173.     loop
174.     eval_add# = n
175. end function
176.  
177. function eval_mod#(dummy)
178.     dim n as double
179.  
180.     n = eval_idiv#(0)
181.     do while tok = MODULUS
182.         next_tok: n = n mod eval_idiv#(0)
183.     loop
184.     eval_mod# = n
185. end function
186.  
187. function eval_idiv#(dummy)
188.     dim n as double
189.  
190.     n = eval_mul#(0)
191.     do while tok = INT_DIV
192.         next_tok: n = n \ eval_mul#(0)
193.     loop
194.     eval_idiv# = n
195. end function
196.  
197. function eval_mul#(dummy)
198.     dim n as double
199.  
200.     n = eval_pow#(0)
201.     do
202.         select case tok
203.             case MULTIPLY: next_tok:  n = n * eval_pow#(0)
204.             case DIVIDE:   next_tok:  n = n / eval_pow#(0)
205.             case else: exit do
206.         end select
207.     loop
208.     eval_mul# = n
209. end function
210.  
211. function eval_pow#(dummy)
212.     dim n as double
213.  
214.     n = factor#(0)
215.     do while tok = POWER
216.         next_tok:  n = n ^ factor#(0)
217.     loop
218.     eval_pow# = n
219. end function
220.  
221. function factor#(dummy)
222.     dim n as double
223.     dim fun as string
224.  
225.     select case tok
226.         case NUMBER:   n = val(id_name): next_tok
227.         case ADD:      next_tok: n =     factor#(0)
228.         case SUBTRACT: next_tok: n =    -factor#(0)
229.         case NOT_T:    next_tok: n = not factor#(0)
230.         case LPAREN
231.             next_tok
232.             n = evalr#(0)
233.             call expect(RPAREN, ")")
234.         case ID
235.             fun = id_name
236.             next_tok
237.             call expect(LPAREN, "(")
238.             n = evalr#(0)
239.             call expect(RPAREN, ")")
240.             n = builtin(fun, n)
241.         case else: print "Expecting a factor": n = 0
242.     end select
243.     factor# = n
244. end function
245.  
246. function builtin#(fun as string, arg as double)
247.     dim n as double
248.  
249.     select case lcase$(fun)
250.         case "abs": n = abs(arg)
251.         case "atn": n = atn(arg)
252.         case "cos": n = cos(arg)
253.         case "exp": n = exp(arg)
254.         case "fix": n = fix(arg)
255.         case "int": n = int(arg)
256.         case "log": n = log(arg)
257.         case "rnd": n = rnd(arg)
258.         case "sgn": n = sgn(arg)
259.         case "sin": n = sin(arg)
260.         case "sqr": n = sqr(arg)
261.         case "tan": n = tan(arg)
262.         case else: n = 0: print "Expecting a function, found: "; fun
263.     end select
264.     builtin# = n
265. end function
266.  
267. sub expect(n as integer, s as string)
268.     if tok = n then next_tok: exit sub
269.     print "Expecting: "; s
270. end sub
271.  
272. sub next_tok
273.     id_name = ""
274.     tok = 0
275.  
276.     ' skip spaces
277.     input_st = ltrim$(input_st)
278.  
279.     if input_st = "" then exit sub
280.  
281.     ' pick off a few multichar operators
282.     select case lcase$(left$(input_st, 2))
283.         case ">=": input_st = mid$(input_st, 3): tok = GTR_T_EQL
284.         case "<=": input_st = mid$(input_st, 3): tok = LSS_T_EQL
285.         case "<>": input_st = mid$(input_st, 3): tok = NOT_EQUAL
286.         case else
287.             ' now do the rest, based on first letter
288.         select case lcase$(left$(input_st, 1))
289.             case "0" to "9"
290.                 do
291.                     id_name = id_name + left$(input_st, 1)
292.                     input_st = mid$(input_st, 2)
293.                 loop while (left$(input_st, 1) >= "0" and left$(input_st, 1) <= "9") or left$(input_st, 1) = "."
294.                 tok = NUMBER
295.             case "a" to "z"
296.                 do
297.                     id_name = id_name + left$(input_st, 1)
298.                     input_st = mid$(input_st, 2)
299.                 loop while left$(input_st, 1) >= "a" and left$(input_st, 1) <= "z"
300.                 select case lcase$(id_name)
301.                     case "mod": tok = MODULUS:
302.                     case "not": tok = NOT_T:
303.                     case "and": tok = AND_T:
304.                     case "or" : tok = OR_T:
305.                     case "eqv": tok = EQV_T:
306.                     case "imp": tok = IMP_T:
307.                     case "xor": tok = XOR_T:
308.                     case else:  tok = ID:
309.                 end select
310.  
311.             case "^": input_st = mid$(input_st, 2): tok = POWER
312.             case "*": input_st = mid$(input_st, 2): tok = MULTIPLY
313.             case "/": input_st = mid$(input_st, 2): tok = DIVIDE
314.             case "\": input_st = mid$(input_st, 2): tok = INT_DIV
315.             case "+": input_st = mid$(input_st, 2): tok = ADD
316.             case "-": input_st = mid$(input_st, 2): tok = SUBTRACT
317.             case "=": input_st = mid$(input_st, 2): tok = EQUAL
318.             case "(": input_st = mid$(input_st, 2): tok = LPAREN
319.             case ")": input_st = mid$(input_st, 2): tok = RPAREN
320.             case ">": input_st = mid$(input_st, 2): tok = GTR_T
321.             case "<": input_st = mid$(input_st, 2): tok = LSS_T
322.             case else: print "Unknown token encountered"
323.         end select
324.     end select
325. end sub
326.  

Text Only | Text with Attachments