home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / parsex.icn < prev    next >
Text File  |  2000-07-29  |  4KB  |  168 lines
  1. ############################################################################
  2. #
  3. #    File:     parsex.icn
  4. #
  5. #    Subject:  Program to parse arithmetic expressions
  6. #
  7. #    Author:   Cheyenne Wills
  8. #
  9. #    Date:     June 10, 1988
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  Adapted from C code written by Allen I. Holub published in the
  18. #  Feb 1987 issue of Dr. Dobb's Journal.
  19. #
  20. #  General purpose expression analyzer.  Can evaluate any expression
  21. #  consisting of number and the following operators (listed according
  22. #  to precedence level):
  23. #
  24. #  () - ! 'str'str'
  25. #  * / &
  26. #  + -
  27. #  < <= > >= == !=
  28. #  && ||
  29. #
  30. # All operators associate left to right unless () are present.
  31. # The top - is a unary minus.
  32. #
  33. #
  34. #  <expr>   ::= <term> <expr1>
  35. #  <expr1>  ::= && <term> <expr1>
  36. #        ::= || <term> <expr1>
  37. #        ::= epsilon
  38. #
  39. #  <term>   ::= <fact> <term1>
  40. #  <term1>  ::= <  <fact> <term1>
  41. #        ::= <= <fact> <term1>
  42. #        ::= >  <fact> <term1>
  43. #        ::= >= <fact> <term1>
  44. #        ::= == <fact> <term1>
  45. #        ::= != <fact> <term1>
  46. #        ::= epsilon
  47. #
  48. #  <fact>   ::= <part> <fact1>
  49. #  <fact1>  ::= + <part> <fact1>
  50. #        ::= - <part> <fact1>
  51. #        ::= - <part> <fact1>
  52. #        ::= epsilon
  53. #
  54. #  <part>   ::= <const> <part1>
  55. #  <part1>  ::= * <const> <part1>
  56. #        ::= / <const> <part1>
  57. #        ::= % <const> <part1>
  58. #        ::= epsilon
  59. #
  60. #  <const>  ::= ( <expr> )
  61. #        ::= - ( <expr> )
  62. #        ::= - <const>
  63. #        ::= ! <const>
  64. #        ::= 's1's2'    # compares s1 with s2  0 if ~= else 1
  65. #        ::= NUMBER       # number is a lose term any('0123456789.Ee')
  66. #
  67. ############################################################################
  68.  
  69. procedure main()
  70.    local line
  71.  
  72.    writes("->")
  73.    while line := read() do {
  74.        write(parse(line))
  75.        writes("->")
  76.        }
  77. end
  78.  
  79. procedure parse(exp)
  80.    return exp ? expr()
  81. end
  82.  
  83. procedure expr(exp)
  84.    local lvalue
  85.  
  86.    lvalue := term()
  87.    repeat {
  88.        tab(many(' \t'))
  89.        if ="&&" then lvalue := iand(term(),lvalue)
  90.        else if ="||" then lvalue := ior(term(),lvalue)
  91.        else break
  92.        }
  93.    return lvalue
  94. end
  95.  
  96. procedure term()
  97.    local lvalue
  98.  
  99.    lvalue := fact()
  100.    repeat {
  101.        tab(many(' \t'))
  102.        if      ="<=" then lvalue := if lvalue <= fact() then 1 else 0
  103.        else if ="<"  then lvalue := if lvalue <  fact() then 1 else 0
  104.        else if =">=" then lvalue := if lvalue >= fact() then 1 else 0
  105.        else if =">"  then lvalue := if lvalue >  fact() then 1 else 0
  106.        else if ="==" then lvalue := if lvalue =  fact() then 1 else 0
  107.        else if ="!=" then lvalue := if lvalue ~= fact() then 1 else 0
  108.        else break
  109.        }
  110.    return lvalue
  111. end
  112.  
  113. procedure fact()
  114.    local lvalue
  115.  
  116.    lvalue := part()
  117.    repeat {
  118.        tab(many(' \t'))
  119.        if ="+" then lvalue +:= part()
  120.        else if ="-" then lvalue -:= part()
  121.        else break
  122.        }
  123.    return lvalue
  124. end
  125.  
  126. procedure part()
  127.    local lvalue
  128.  
  129.    lvalue := const()
  130.    repeat {
  131.        tab(many(' \t'))
  132.        if ="*" then lvalue *:= part()
  133.        else if ="%" then lvalue %:= part()
  134.        else if ="/" then lvalue /:= part()
  135.        else break
  136.        }
  137.    return lvalue
  138. end
  139.  
  140. procedure const()
  141.    local sign, logical, rval, s1, s2
  142.  
  143.    tab(many(' \t'))
  144.  
  145.    if ="-" then sign := -1 else sign := 1
  146.    if ="!" then logical := 1 else logical := &null
  147.    if ="(" then {
  148.        rval := expr()
  149.        if not match(")") then {
  150.        write(&subject)
  151.        write(right("",&pos-1,"_"),"^ Mis-matched parenthesis")
  152.        }
  153.        else move(1)
  154.        }
  155.    else if ="'" then {
  156.        s1 := tab(upto('\''))
  157.        move(1)
  158.        s2 := tab(upto('\''))
  159.        move(1)
  160.        rval := if s1 === s2 then 1 else 0
  161.        }
  162.    else {
  163.        rval := tab(many('0123456789.eE'))
  164.        }
  165.    if \logical then { return if rval = 0 then 1 else 0 }
  166.    else return rval * sign
  167. end
  168.