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 / packs / ibpag2 / iacc.ibp < prev    next >
Text File  |  2000-07-29  |  12KB  |  496 lines
  1. ############################################################################
  2. #
  3. #    Name:     iacc.ibp
  4. #
  5. #    Title:     YACC-like front-end for Ibpag2 (experimental)
  6. #
  7. #    Author:     Richard L. Goerwitz
  8. #
  9. #    Version: 1.6
  10. #
  11. ############################################################################
  12. #
  13. #  Summary:
  14. #
  15. #      Iacc is a YACC-like Ibpag2 preprocessor (very experimental).
  16. #  Iacc simply reads &input (assumed to be a YACC file, but with Icon
  17. #  code in the action fields), and writes an Ibpag2 file to &output.
  18. #
  19. ############################################################################
  20. #
  21. #  Installation:
  22. #
  23. #      This file is not an Icon file, but rather an Ibpag2 file.  You
  24. #  must have Ibpag2 installed in order to run it.  To create the iacc
  25. #  executable, first create iacc.icn by typing "ibpag2 -f iacc.ibp -o
  26. #  iacc.icn," then compile iacc.icn as you would any other Icon file
  27. #  to create iacc (or on systems without direct execution, iacc.icx).
  28. #  Put more simply, iacc.ibp not only outputs Ibpag2 files, but is
  29. #  itself generated using Ibpag2 + icon{t,c}.
  30. #
  31. ############################################################################
  32. #
  33. #  Implementation notes:
  34. #
  35. #      Iacc uses an YACC grammar that is actually LR(2), and not
  36. #  LR(1), as Ipbag2 would normally require in standard mode.  Iacc
  37. #  obtains the additional token lookahead via the lexical analyzer.
  38. #  The place it uses that lookahead is when it sees an identifier.  If
  39. #  the next token is a colon, then it is the LHS of a rule (C_IDENT
  40. #  below); otherwise it's an IDENT in the RHS of some rule.  Crafting
  41. #  the lexical analyzer in this fashion makes semicolons totally
  42. #  superfluous (good riddance!), but it makes it necessary for the
  43. #  lexical analyzer to suspend some dummy tokens whose only purpose is
  44. #  to make sure that it doesn't eat up C or Icon action code while
  45. #  trying to satisfy the grammar's two-token lookahead requirements
  46. #  (see how RCURL and '}' are used below in the cdef and act
  47. #  productions).
  48. #
  49. #      Iacc does its work by making six basic changes to the input
  50. #  stream: 1) puts commas between tokens and symbols in rules, 2)
  51. #  removes superfluous union and type declarations/tags, 3) inserts
  52. #  "epsilon" into the RHS of empty rules, 4) turns "$$ = x" into
  53. #  "return x", 5) rewrites rules so that all actions appear at the end
  54. #  of a production, and 6) strips all comments.
  55. #
  56. #      Although Iacc is really meant for grammars with Icon action
  57. #  code, Iacc can, in fact, accept straight YACC files, with C action
  58. #  code.  There isn't much point to using it this way, though, since
  59. #  its output is not meant to be human readable.  Rather, it is to be
  60. #  passed directly to Ibpag2 for processing.  Iacc is simply a YACCish
  61. #  front end.  Its output can be piped directly to Ibpag2 in most
  62. #  cases:  iacc < infile.iac | ibpag2 > infile.icn.
  63. #
  64. ############################################################################
  65. #
  66. #  Links: longstr, strings
  67. #  See also: ibpag2
  68. #
  69. ############################################################################
  70.  
  71. %{
  72.  
  73. link strings, longstr
  74. global newrules, lval, symbol_no
  75.  
  76. %}
  77.  
  78. # basic entities
  79. %token C_IDENT, IDENT    # identifiers and literals
  80. %token NUMBER            # [0-9]+
  81.  
  82. # reserved words:  %type -> TYPE, %left -> LEFT, etc.
  83. %token LEFT, RIGHT, NONASSOC, TOKEN, PREC, TYPE, START, UNION
  84.  
  85. # miscellaneous
  86. %token MARK   # %%
  87. %token LCURL  # %{
  88. %token RCURL  # dummy token used to start processing of C code
  89.  
  90. %start yaccf
  91.  
  92. %%
  93.  
  94. yaccf    : front, back
  95. front    : defs, MARK        { write(arg2) }
  96. back    : rules, tail        {
  97.                   every write(!\newrules)
  98.                   if write(\arg2) then
  99.                       every write(!&input)
  100.                 }
  101. tail    : epsilon        { return &null }
  102.     | MARK            { return arg1 }
  103.  
  104. defs    : epsilon
  105.     | defs, def        { write(\arg2) }
  106.     | defs, cdef        { write(\arg2) }
  107.  
  108. def    : START, IDENT        { return arg1 || " " || arg2 }
  109.     | rword, tag, nlist    {
  110.                   if arg1 == "%type"
  111.                   then return &null
  112.                   else return arg1 || " " || arg3
  113.                 }
  114. cdef    : stuff, RCURL, RCURL    { return arg1 }
  115. stuff    : UNION            { get_icon_code("%}"); return &null }
  116.     | LCURL            { return "%{ " || get_icon_code("%}") }
  117.  
  118. rword    : TOKEN    | LEFT | RIGHT | NONASSOC | TYPE
  119.  
  120. tag    : epsilon        { return &null }
  121.     | '<', IDENT, '>'    { return "<" || arg2 || ">" }
  122.  
  123. nlist    : nmno            { return arg1 }
  124.     | nlist, nmno        { return arg1 || ", " || arg2 }
  125.     | nlist, ',', nmno    { return arg1 || ", " || arg3 }
  126.  
  127. nmno    : IDENT            { return arg1 }
  128.     | IDENT, NUMBER        { return arg1 }
  129.     
  130. rules    : LHS, ':', RHS        { write(arg1, "\t: ", arg3) }
  131.     | rules, rule        { write(arg2) }
  132.  
  133. RHS    : rbody, prec        { return arg1 || " " || arg2 }
  134.  
  135. rule    : LHS, '|', RHS        { return "\t| " || arg3 }
  136.     | LHS, ':', RHS        { return arg1 || "\t: " || arg3 }
  137.  
  138. LHS    : C_IDENT        { symbol_no := 0 ; return arg1 }
  139.     | epsilon        { symbol_no := 0 }
  140.  
  141. rbody    : IDENT            { symbol_no +:= 1; return arg1 }
  142.     | act            { return "epsilon " || arg1 }
  143.     | middle, IDENT        { return arg1 || ", " || arg2 }
  144.     | middle, act        { return arg1 || " "  || arg2 }
  145.     | middle, ',', IDENT    { return arg1 || ", " || arg3 }
  146.     | epsilon        { return "epsilon" }
  147.  
  148. middle    : IDENT            { symbol_no +:= 1; return arg1 }
  149.     | act            { symbol_no +:= 1; return arg1 }
  150.     | middle, IDENT        { symbol_no +:= 1; return arg1 || ", "||arg2 }
  151.     | middle, ',', IDENT    { symbol_no +:= 1; return arg1 || ", "||arg3 }
  152.     | middle, act        {
  153.                   local i, l1, l2
  154.                   static actno
  155.                   initial { actno := 0; newrules := [] }
  156.                   actno +:= 1
  157.                   l1 := []; l2 := []
  158.                   every i := 1 to symbol_no do {
  159.                       every put(l1, ("arg"|"$") || i)
  160.                       if symbol_no-i = 0 then i := "0"
  161.                       else i := "-" || symbol_no - i
  162.                       every put(l2, ("$"|"$") || i)
  163.                   }
  164.                   put(newrules, "ACT_"|| actno ||
  165.                     "\t: epsilon "|| mapargs(arg2, l1, l2))
  166.                   symbol_no +:= 1
  167.                   return arg1 || ", " || "ACT_" || actno
  168.                 }
  169.  
  170. act    : '{', cstuff, '}', '}'    { return "{" || arg2 }
  171. cstuff    : epsilon        { return get_icon_code("}") }
  172.  
  173. prec    : epsilon        { return "" }
  174.     | PREC, IDENT        { return arg1 || arg2 }
  175.     | PREC, IDENT, act    { return arg1 || arg2 || arg3 }
  176.  
  177.  
  178. %%
  179.  
  180.  
  181. procedure iilex()
  182.  
  183.     local t
  184.     static last_token, last_lval, colon
  185.     initial colon := ord(":")
  186.  
  187.     every t := next_token() do {
  188.     iilval := last_lval
  189.     if \last_token then {
  190.         if t = colon then {
  191.         if last_token = IDENT
  192.         then suspend C_IDENT
  193.         else suspend last_token
  194.         } else
  195.         suspend last_token
  196.     }
  197.     last_token := t
  198.     last_lval := lval
  199.     }
  200.     iilval := last_lval
  201.     suspend \last_token
  202.  
  203. end
  204.  
  205.  
  206. procedure next_token()
  207.  
  208.     local reserveds, UNreserveds, c, idchars, marks
  209.  
  210.     reserveds := ["break","by","case","create","default","do",
  211.           "else","end","every","fail","global","if",
  212.           "initial","invocable","link","local","next",
  213.           "not","of","procedure","record","repeat",
  214.           "return","static","suspend","then","to","until",
  215.           "while"]
  216.  
  217.     UNreserveds := ["break_","by_","case_","create_","default_","do_",
  218.             "else_","end_","every_","fail_","global_","if_",
  219.             "initial_","invocable_","link_","local_","next_",
  220.             "not_","of_","procedure_","record_","repeat_",
  221.             "return_","static_","suspend_","then_","to_",
  222.             "until_","while_"]
  223.  
  224.     idchars := &letters ++ '._'
  225.     marks := 0
  226.  
  227.     c := reads()
  228.     repeat {
  229.     lval := &null
  230.     case c of {
  231.         "#" : { do_icon_comment(); c := reads() | break }
  232.         "<" : { suspend ord(c); c := reads() | break }
  233.         ">" : { suspend ord(c); c := reads() | break }
  234.         ":" : { suspend ord(c); c := reads() | break }
  235.         "|" : { suspend ord(c); c := reads() | break }
  236.         "," : { suspend ord(c); c := reads() | break }
  237.         "{" : { suspend ord(c | "}" | "}"); c := reads() }
  238.         "/" : {
  239.         reads() == "*" | stop("unknown YACC operator, \"/\"")
  240.         do_c_comment()
  241.         c := reads() | break
  242.         }
  243.         "'" : {
  244.         lval := "'"
  245.         while lval ||:= (c := reads()) do {
  246.             if c == "\\"
  247.             then lval ||:= reads()
  248.             else if c == "'" then {
  249.             suspend IDENT
  250.             break
  251.             }
  252.         }
  253.         c := reads() | break
  254.         }
  255.         "%" : {
  256.         lval := "%"
  257.         while any(&letters, c := reads()) do 
  258.             lval ||:= c
  259.         if *lval = 1 then {
  260.             if c == "%" then {
  261.             lval := "%%"
  262.             suspend MARK
  263.             if (marks +:= 1) > 1 then
  264.                 fail
  265.             } else {
  266.             if c == "{" then {
  267.                 lval := "%{"
  268.                 suspend LCURL | RCURL | RCURL
  269.             }
  270.             else stop("malformed %declaration")
  271.             }
  272.             c := reads() | break
  273.         } else {
  274.             case lval of {
  275.             "%prec"     : suspend PREC
  276.             "%left"     : suspend LEFT
  277.             "%token"    : suspend TOKEN
  278.             "%right"    : suspend RIGHT
  279.             "%type"     : suspend TYPE
  280.             "%start"    : suspend START
  281.             "%union"    : suspend UNION | RCURL | RCURL
  282.             "%nonassoc" : suspend NONASSOC
  283.             default    : stop("unknown % code in def section")
  284.             }
  285.         }
  286.         }
  287.         default : {
  288.         if any(&digits, c) then {
  289.             lval := c
  290.             while any(&digits, c := reads()) do
  291.             lval ||:= c
  292.             suspend NUMBER
  293.         }    
  294.         else {
  295.             if any(idchars, c) then {
  296.             lval := c
  297.             while any(&digits ++ idchars, c := reads()) do
  298.                 lval ||:= c
  299.             lval := mapargs(lval, reserveds, UNreserveds)
  300.             suspend IDENT
  301.             }
  302.             else {
  303.             # whitespace
  304.             c := reads() | break
  305.             }
  306.         }
  307.         }
  308.     }
  309.     }
  310.  
  311.  
  312. end
  313.  
  314.  
  315. procedure get_icon_code(endmark, comment)
  316.  
  317.     local yaccwords, ibpagwords, count, c, c2, s
  318.  
  319.     yaccwords := ["YYDEBUG", "YYACCEPT", "YYERROR", "yyclearin", "yyerrok"]
  320.     ibpagwords := ["IIDEBUG", "IIACCEPT", "IIERROR", "iiclearin", "iierrok"]
  321.  
  322.     s := ""
  323.     count := 1
  324.     c := reads()
  325.  
  326.     repeat {
  327.     case c of {
  328.         "\""    :  s ||:= c || do_string()
  329.         "'"     :  s ||:= c || do_charlit()
  330.         "$"     :  {
  331.         c2 := reads() | break
  332.         if c2 == "$" then {
  333.             until (c := reads()) == "="
  334.             s ||:= "return "
  335.         } else {
  336.             s ||:= c
  337.             c := c2
  338.             next
  339.         }
  340.         }
  341.         "#"     :  {
  342.         if s[-1] == "\n"
  343.         then s[-1] := ""
  344.         do_icon_comment()
  345.         }
  346.         "/" : {
  347.         c := reads() | break
  348.         if c == "*" then
  349.             do_c_comment()
  350.         else {
  351.             s ||:= c
  352.             next
  353.         }
  354.         }
  355.         "{"     :  {
  356.         s ||:= c
  357.         if endmark == "}" then
  358.             count +:= 1
  359.         }
  360.         "}"     :  {
  361.         s ||:= c
  362.         if endmark == "}" then {
  363.             count -:= 1
  364.             count = 0 & (return mapargs(s, yaccwords, ibpagwords))
  365.         }
  366.         }
  367.         "%"     :  {
  368.         s ||:= c
  369.         if endmark == "%}" then {
  370.             if (c := reads()) == "}"
  371.             then return mapargs(s || c, yaccwords, ibpagwords)
  372.             else next
  373.         }
  374.         }
  375.         default : s ||:= c
  376.     }
  377.     c := reads() | break
  378.     }
  379.  
  380.     # if there is no endmark, just go to EOF
  381.     if \endmark
  382.     then stop("input file has mis-braced { code }")
  383.     else return mapargs(s, yaccwords, ibpagwords)
  384.  
  385. end
  386.  
  387.  
  388. procedure do_string()
  389.  
  390.     local c, s
  391.  
  392.     s := ""
  393.     while c := reads() do {
  394.     case c of {
  395.         "\\"    : s ||:= c || reads()
  396.         "\""    : return s || c || reads()
  397.         default : s ||:= c
  398.     }
  399.     }
  400.  
  401.     stop("malformed string literal")
  402.  
  403. end
  404.  
  405.  
  406. procedure do_charlit()
  407.  
  408.     local c, s
  409.  
  410.     s := ""
  411.     while c := reads() do {
  412.     case c of {
  413.         "\\"    : s ||:= c || reads()
  414.         "'"     : return s || c || reads()
  415.         default : s ||:= c
  416.     }
  417.     }
  418.  
  419.     stop("malformed character literal")
  420.  
  421. end
  422.  
  423.  
  424. procedure do_c_comment()
  425.  
  426.     local c, s
  427.  
  428.     s := c := reads() |
  429.     stop("malformed C-style /* comment */")
  430.  
  431.     repeat {
  432.     if c == "*" then {
  433.         s ||:= (c := reads() | break)
  434.         if c == "/" then
  435.         return s
  436.     }
  437.     else s ||:= (c := reads() | break)
  438.     }
  439.  
  440.     return s            # EOF okay
  441.  
  442. end
  443.  
  444.  
  445. procedure do_icon_comment()
  446.  
  447.     local c, s
  448.  
  449.     s := ""
  450.     while c := reads() do {
  451.     case c of {
  452.         "\\"    : s ||:= c || (reads() | break)
  453.         "\n"    : return s
  454.         default : s ||:= c
  455.     }
  456.     }
  457.  
  458.     return s            # EOF okay
  459.  
  460. end
  461.  
  462.  
  463. procedure mapargs(s, l1, l2)
  464.  
  465.     local i, s2
  466.     static cs, tbl, last_l1, last_l2
  467.  
  468.     if /l1 | *l1 = 0 then return s
  469.  
  470.     if not (last_l1 === l1, last_l2 === l2) then {
  471.     cs := ''
  472.     every cs ++:= (!l1)[1]
  473.     tbl := table()
  474.     every i := 1 to *l1 do
  475.         insert(tbl, l1[i], (\l2)[i] | "")
  476.     }
  477.  
  478.     s2 := ""
  479.     s ? {
  480.     while s2 ||:= tab(upto(cs)) do {
  481.         (s2 <- (s2 || tbl[tab(longstr(l1))]),
  482.             not any(&letters++&digits++'_')) |
  483.             (s2 ||:= move(1))
  484.     }
  485.     s2 ||:= tab(0)
  486.     }
  487.  
  488.     return s2
  489.  
  490. end
  491.  
  492.  
  493. procedure main()
  494.     iiparse()
  495. end
  496.