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 / ibutil.icn < prev    next >
Text File  |  2000-07-29  |  7KB  |  297 lines
  1. ############################################################################
  2. #
  3. #    Name:     ibutil.icn
  4. #
  5. #    Title:     utilities for Ibpag2
  6. #
  7. #    Author:     Richard L. Goerwitz
  8. #
  9. #    Version: 1.21
  10. #
  11. ############################################################################
  12. #  
  13. #  Contains:
  14. #
  15. #      production_2_string(p)        makes production or item p human-
  16. #                    readable 
  17. #
  18. #      print_item_list(C, i)        returns human-readable version of
  19. #                                   item list C
  20. #
  21. #      print_grammar(grammar, f)    sends to file f (default &output)
  22. #                                   a human-readable printout of a grammar,
  23. #                                   as recorded in an ib_grammar structure
  24. #
  25. #      print_action_goto_tables(atbl, gtbl, ibtoktbl, f)
  26. #                                   sends to file f (default (&output)
  27. #                                   a human-readable printout of action
  28. #                                   table atbl and goto table gtbl
  29. #
  30. #      print_follow_sets(FOLLOW_table)
  31. #                                   returns a human-readable version
  32. #                                   of a FOLLOW table (table of sets)
  33. #
  34. #      print_first_sets(FIRST_table)
  35. #                                   returns a human-readable version
  36. #                                   of a FIRST table (a table of sets)
  37. #
  38. #      ibreplace(s1, s2, s3)        replaces s2 with s3 in s1
  39. #
  40. #      equivalent_items(i1, i2)     succeeds if item i1 is structurally
  41. #                    identical to item i2
  42. #
  43. #      equivalent_item_lists(l1,l2) same as equivalent_items, but for
  44. #                                   lists of items, not individual items
  45. #
  46. ############################################################################
  47. #
  48. #  Links: none
  49. #
  50. ############################################################################
  51.  
  52.  
  53. record production(LHS, RHS, POS, LOOK, no, prec, assoc)
  54.  
  55. #
  56. # production_2_string:  production record -> string
  57. #                       p                 -> s
  58. #
  59. #     Stringizes an image of the LHS and RHS of production p in
  60. #     human-readable form.
  61. #
  62. procedure production_2_string(p, ibtoktbl)
  63.  
  64.     local s, m, t
  65.  
  66.     s := image(p.LHS) || " -> "
  67.     every m := !p.RHS do {
  68.     if t := \ (\ibtoktbl)[m]
  69.     then s ||:= t || " "
  70.     else s ||:= image(m) || " "
  71.     }
  72.     # if the POS field is nonnull, print it
  73.     s ||:= "(POS = " || image(\p.POS) || ") "
  74.     # if the LOOK field is nonnull, print it, too
  75.     s ||:= "lookahead = " || image(\p.LOOK)
  76.  
  77.     return trim(s)
  78.  
  79. end
  80.  
  81.  
  82. #
  83. # print_item_list:  makes item list human readable
  84. #
  85. procedure print_item_list(C, i)
  86.  
  87.     write(&errout, "Productions for item list ", i, ":")
  88.     every write(&errout, "\t", production_2_string(!C[i]))
  89.     write(&errout)
  90.     return
  91.  
  92. end
  93.  
  94.  
  95. #
  96. # print_grammar:  makes entire grammar human readable
  97. #
  98. procedure print_grammar(grammar, f)
  99.  
  100.     local p, i, sl
  101.  
  102.     /f := &errout
  103.  
  104.     write(f, "Start symbol:")
  105.     write(f, "\t", grammar.start)
  106.     write(f)
  107.     write(f, "Rules:")
  108.     every p := !grammar.rules do {
  109.     writes(f, "\tRule ", right(p.no, 3, " "), "  ")
  110.     write(f, production_2_string(p, grammar.tbl))
  111.     }
  112.     write(f)
  113.     write(f, "Tokens:")
  114.     sl := sort(grammar.tbl, 3)
  115.     every i := 1 to *sl-1 by 2 do
  116.     write(f, "\t", left(sl[i], 5, "."), right(sl[i+1], 20, "."))
  117.     write(f)
  118.     return
  119.  
  120. end
  121.  
  122.  
  123. #
  124. # print_action_goto_tables
  125. #
  126. #     Makes action & goto tables human readable.  If a table mapping
  127. #     integer (i.e. char) literals to token names is supplied, the
  128. #     token names themselves are printed.
  129. #
  130. procedure print_action_goto_tables(atbl, gtbl, ibtoktbl, f)
  131.  
  132.     local TAB, tbl, key_set, size, i, column, k
  133.  
  134.     /f := &errout
  135.     TAB := "\t"
  136.  
  137.     every tbl := atbl|gtbl do {
  138.  
  139.     key_set := set(); every insert(key_set, key(tbl))
  140.     writes(f, TAB)
  141.     every k := !key_set do
  142.         writes(f, \(\ibtoktbl)[k] | k, TAB)
  143.     write(f)
  144.     
  145.     size := 0; every size <:= key(!tbl)
  146.     every i := 1 to size do {
  147.         writes(f, i, TAB)
  148.         every column := tbl[!key_set] do {
  149.         # action lists may have more than one element
  150.         if /column[i] then
  151.             writes(f, "  ", TAB) & next
  152.         \column[i] ? {
  153.             if any('asr') then {
  154.             while any('asr') do {
  155.                 writes(f, ="a") & next
  156.                 writes(f, tab(upto('.<')))
  157.                 if ="<" then tab(find(">")+1) else ="."
  158.                 tab(many(&digits))
  159.             }
  160.             writes(f, TAB)
  161.             }
  162.             else writes(f, tab(many(&digits)), TAB)
  163.         }
  164.         }
  165.         write(f)
  166.     }
  167.     write(f)
  168.     }
  169.  
  170.     return
  171.  
  172. end
  173.  
  174.  
  175. #
  176. # print_follow_sets:  make FOLLOW table human readable
  177. #
  178. procedure print_follow_sets(FOLLOW_table)
  179.  
  180.     local FOLLOW_sets, i
  181.  
  182.     FOLLOW_sets := sort(FOLLOW_table, 3)
  183.     write(&errout, "FOLLOW sets are as follows:")
  184.     every i := 1 to *FOLLOW_sets-1 by 2 do {
  185.     writes(&errout, "\tFOLLOW(", image(FOLLOW_sets[i]), ") = ")
  186.     every writes(&errout, image(! FOLLOW_sets[i+1]), " ")
  187.     write(&errout)
  188.     }
  189.     write(&errout)
  190.     return
  191.  
  192. end
  193.  
  194.  
  195. #
  196. # print_first_sets:  make FIRST table human readable
  197. #
  198. procedure print_first_sets(FIRST_table)
  199.  
  200.     local FIRST_sets, i
  201.  
  202.     FIRST_sets := sort(FIRST_table, 3)
  203.     write(&errout, "FIRST sets are as follows:")
  204.     every i := 1 to *FIRST_sets-1 by 2 do {
  205.     writes(&errout, "\tFIRST(", image(FIRST_sets[i]), ") = ")
  206.     every writes(&errout, image(! FIRST_sets[i+1]), " ")
  207.     write(&errout)
  208.     }
  209.     write(&errout)
  210.     return
  211.  
  212. end
  213.  
  214.  
  215. #
  216. # ibreplace: string x string x string -> string
  217. #            (s1,     s2,      s3)    -> s4
  218. #
  219. #     Where s4 is s1, with every instance of s2 stripped out and
  220. #     replaced by s3.  E.g. replace("hello there; hello", "hello",
  221. #     "hi") yields "hi there; hi".  Taken straight from the IPL.
  222. #
  223. procedure ibreplace(s1,s2,s3)
  224.  
  225.     local result, i
  226.  
  227.     result := ""
  228.     i := *s2
  229.  
  230.     s1 ? {
  231.     while result ||:= tab(find(s2)) do {
  232.         result ||:= s3
  233.         move(i)
  234.     }
  235.     return result || tab(0)
  236.     }
  237.  
  238. end
  239.  
  240.     
  241. #
  242. # equivalent_items:  record x record -> record or failure
  243. #                    (item1,  item2) -> item1  or failure
  244. #
  245. #     Where item1 and item2 are records having LHS, RHS, POS, & LOOK
  246. #     fields (and possibly others, though they aren't used).  Returns
  247. #     item1 if item1 and item2 are structurally identical as far as
  248. #     their LHS, RHS, LOOK, and POS fields are concerned.  For SLR
  249. #     table generators, LOOK will always be null.
  250. #
  251. procedure equivalent_items(item1, item2)
  252.  
  253.     local i
  254.  
  255.     item1 === item2 & (return item1)
  256.  
  257.     if item1.LHS == item2.LHS &
  258.     item1.POS = item2.POS &
  259.     #
  260.     # This comparison doesn't have to be recursive, since I take
  261.     # care never to alter RHS structures.  Identical RHSs should
  262.     # always be *the same underlying structure*.
  263.     #
  264.     item1.RHS === item2.RHS &
  265.     item1.LOOK === item2.LOOK
  266.     then
  267.     return item1
  268.  
  269. end
  270.  
  271.  
  272. #
  273. # equivalent_item_lists: list x list -> list or fail
  274. #                        (il1,  il2) -> il1
  275. #
  276. #     Where il1 is one sorted list-of-items (as returned by goto() or
  277. #     by closure()), where il2 is another such list.  Returns the
  278. #     first list if the LHS, RHS, and POS fields of the constituent
  279. #     items are all structurally identical, i.e. if the two lists
  280. #     contain the structurally identical items.
  281. #
  282. procedure equivalent_item_lists(il1, il2)
  283.  
  284.     local i
  285.  
  286.     il1 === il2 & (return il1)
  287.     if *il1 = *il2
  288.     then {
  289.     every i := 1 to *il1 do
  290.             equivalent_items(il1[i], il2[i]) | fail
  291.     }
  292.     else fail
  293.  
  294.     return il1
  295.  
  296. end
  297.