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 / parse.icn < prev    next >
Text File  |  2000-07-29  |  3KB  |  134 lines
  1. ############################################################################
  2. #
  3. #    File:     parse.icn
  4. #
  5. #    Subject:  Program to parse simple statements
  6. #
  7. #    Author:   Kenneth Walker
  8. #
  9. #    Date:     February 18, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This program parses simple statements.
  18. #
  19. #  It provides an interesting example of the use of co-expressions.
  20. #
  21. ############################################################################
  22.  
  23. global lex    # co-expression for lexical analyzer
  24. global next_tok    # next token from input
  25.  
  26. record token(type, string)
  27.  
  28. procedure main()
  29.    lex := create ((!&input ? get_tok()) | |token("eof", "eof"))
  30.    prog()
  31. end
  32.  
  33. #
  34. # get_tok is the main body of lexical analyzer
  35. #
  36. procedure get_tok()
  37.    local tok
  38.    repeat {    # skip white space and comments
  39.       tab(many('     '))
  40.       if ="#" | pos(0) then fail
  41.  
  42.       if any(&letters) then    # determine token type
  43.          tok := token("id", tab(many(&letters ++ '_')))
  44.       else if any(&digits) then
  45.          tok := token("integer", tab(many(&digits)))
  46.       else case move(1) of {
  47.          ";"    :    tok := token("semi", ";")
  48.          "("    :    tok := token("lparen", "(")
  49.          ")"    :    tok := token("rparen", ")")
  50.          ":"    :    if ="=" then tok := token("assign", ":=")
  51.                        else tok := token("colon", ":")
  52.          "+"    :    tok := token("add_op", "+")
  53.          "-"    :    tok := token("add_op", "-")
  54.          "*"    :    tok := token("mult_op", "*")
  55.          "/"    :    tok := token("mult_op", "/")
  56.          default    :    err("invalid character in input")
  57.          }
  58.       suspend tok
  59.       }
  60. end
  61.  
  62. #
  63. # The procedures that follow make up the parser
  64. #
  65.  
  66. procedure prog()
  67.    next_tok := @lex
  68.    stmt()
  69.    while next_tok.type == "semi" do {
  70.       next_tok := @lex
  71.       stmt()
  72.       }
  73.    if next_tok.type ~== "eof" then
  74.       err("eof expected")
  75. end
  76.  
  77. procedure stmt()
  78.    if next_tok.type ~== "id" then
  79.       err("id expected")
  80.    write(next_tok.string)
  81.    if (@lex).type ~== "assign" then
  82.       err(":= expected")
  83.    next_tok := @lex
  84.    expr()
  85.    write(":=")
  86. end
  87.  
  88. procedure expr()
  89.    local op
  90.  
  91.    term()
  92.    while next_tok.type == "add_op" do {
  93.       op := next_tok.string
  94.       next_tok := @lex
  95.       term()
  96.       write(op)
  97.       }
  98. end
  99.  
  100. procedure term()
  101.    local op
  102.  
  103.    factor()
  104.    while next_tok.type == "mult_op" do {
  105.       op := next_tok.string
  106.       next_tok := @lex
  107.       factor()
  108.       write(op)
  109.       }
  110. end
  111.  
  112. procedure factor()
  113.    case next_tok.type of {
  114.       "id" | "integer": {
  115.          write(next_tok.string)
  116.          next_tok := @lex
  117.          }
  118.       "lparen": {
  119.          next_tok := @lex
  120.          expr()
  121.          if next_tok.type ~== "rparen" then
  122.             err(") expected")
  123.          else
  124.             next_tok := @lex
  125.          }
  126.       default:
  127.          err("id or integer expected")
  128.       }
  129. end
  130.  
  131. procedure err(s)
  132.    stop(" ** error **  ", s)
  133. end
  134.