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 / ipxref.icn < prev    next >
Text File  |  2000-07-29  |  7KB  |  237 lines
  1. ############################################################################
  2. #
  3. #    File:     ipxref.icn
  4. #
  5. #    Subject:  Program to cross reference Icon program
  6. #
  7. #    Author:   Allan J. Anderson
  8. #
  9. #    Date:     June 14, 1994
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #  
  17. #     This program cross-references Icon programs. It lists the
  18. #  occurrences of each variable by line number. Variables are listed
  19. #  by procedure or separately as globals.  The options specify the
  20. #  formatting of the output and whether or not to cross-reference
  21. #  quoted strings and non-alphanumerics. Variables that are followed
  22. #  by a left parenthesis are listed with an asterisk following the
  23. #  name.  If a file is not specified, then standard input is cross-
  24. #  referenced.
  25. #  
  26. #  Options: The following options change the format defaults:
  27. #  
  28. #       -c n The column width per line number. The default is 4
  29. #            columns wide.
  30. #  
  31. #       -l n The starting column (i.e. left margin) of the line
  32. #            numbers.  The default is column 40.
  33. #  
  34. #       -w n The column width of the whole output line. The default
  35. #            is 80 columns wide.
  36. #  
  37. #     Normally only alphanumerics are cross-referenced. These
  38. #  options expand what is considered:
  39. #  
  40. #       -q   Include quoted strings.
  41. #  
  42. #       -x   Include all non-alphanumerics.
  43. #  
  44. #  Note: This program assumes the subject file is a valid Icon pro-
  45. #  gram. For example, quotes are expected to be matched.
  46. #  
  47. ############################################################################
  48. #
  49. #  Bugs:  In some situations, the output is not properly formatted.
  50. #
  51. ############################################################################
  52. #
  53. #  Links: options
  54. #
  55. ############################################################################
  56.  
  57. link options
  58.  
  59. global resword, linenum, letters, alphas, var, buffer, qflag, infile, xflag
  60. global inmaxcol, inlmarg, inchunk, localvar, lin
  61.  
  62. record procrec(pname,begline,lastline)
  63.  
  64. procedure main(args)
  65.  
  66.    local word, w2, p, prec, i, L, ln, switches, nfile
  67.  
  68.    resword := ["break","by","case","default","do","dynamic","else","end",
  69.       "every","fail","global","if","initial","link", "local","next","not",
  70.       "of","procedure", "record","repeat","return","static","suspend","then",
  71.       "to","until","while","invocable"]
  72.    linenum := 0
  73.    var := table()        # var[variable[proc]] is list of line numbers
  74.    prec := []            # list of procedure records
  75.    localvar := []        # list of local variables of current routine
  76.    buffer := []            # a put-back buffer for getword
  77.    proc := "global"
  78.    letters := &letters ++ '_'
  79.    alphas := letters ++ &digits
  80.  
  81.    switches := options(args,"qxw+l+c+")
  82.  
  83.    if \switches["q"] then qflag := 1
  84.    if \switches["x"] then xflag := 1
  85.    inmaxcol := \switches["w"]
  86.    inlmarg := \switches["l"]
  87.    inchunk := \switches["c"]
  88.    infile := open(args[1],"r")     # could use some checking
  89.  
  90.    while word := getword() do
  91.       if word == "link" then {
  92.          buffer := []
  93.          lin := ""
  94.          next
  95.          }
  96.       else if word == "procedure" then {
  97.          put(prec,procrec("",linenum,0))
  98.          proc := getword() | break
  99.          p := pull(prec)
  100.          p.pname := proc
  101.          put(prec,p)
  102.          }
  103.       else if word == ("global" | "link" | "record") then {
  104.          word := getword() | break
  105.          addword(word,"global",linenum)
  106.          while (w2 := getword()) == "," do {
  107.             if word == !resword then break
  108.             word := getword() | break
  109.             addword(word,"global",linenum)
  110.             }
  111.          put(buffer,w2)
  112.          }
  113.       else if word == ("local" | "dynamic" | "static") then {
  114.          word := getword() | break
  115.          put(localvar,word)
  116.          addword(word,proc,linenum)
  117.          while (w2 := getword()) == "," do {
  118.             if word == !resword then break
  119.             word := getword() | break
  120.             put(localvar,word)
  121.             addword(word,proc,linenum)
  122.             }
  123.          put(buffer,w2)
  124.          }
  125.       else if word == "end" then {
  126.          proc := "global"
  127.          localvar := []
  128.          p := pull(prec)
  129.          p.lastline := linenum
  130.          put(prec,p)
  131.          }
  132.       else if word == !resword then 
  133.          next
  134.       else {
  135.          ln := linenum
  136.          if (w2 := getword()) == "(" then
  137.             word ||:= " *"            # special mark for procedures
  138.          else
  139.             put(buffer,w2)            # put back w2
  140.          addword(word,proc,ln)
  141.          }
  142.    every write(!format(var))
  143.    write("\n\nprocedures:\tlines:\n")
  144.    L := []
  145.    every p := !prec do
  146.       put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
  147.    every write(!sort(L))
  148. end
  149.  
  150. procedure addword(word,proc,lineno)
  151.    if any(letters,word) | \xflag then {
  152.       /var[word] := table()
  153.       if /var[word]["global"] | (word == !\localvar) then {
  154.          /(var[word])[proc] := [word,proc]
  155.          put((var[word])[proc],lineno)
  156.          }
  157.       else {
  158.          /var[word]["global"] := [word,"global"]
  159.          put((var[word])["global"],lineno)
  160.          }
  161.       }
  162. end
  163.  
  164. procedure getword()
  165.    local j, c
  166.    static i, nonwhite
  167.    initial nonwhite := ~' \t\n'
  168.  
  169.    repeat {
  170.       if *buffer > 0 then return get(buffer)
  171.       if /lin | i = *lin + 1 then
  172.          if lin := read(infile) then {
  173.             i := 1
  174.             linenum +:= 1
  175.             }
  176.          else fail
  177.       if i := upto(nonwhite,lin,i) then {   # skip white space
  178.          j := i
  179.          if lin[i] == ("'" | "\"") then {   # don't xref quoted words
  180.             if /qflag then {
  181.                c := lin[i]
  182.                i +:= 1
  183.                repeat
  184.                   if i := upto(c ++ '\\',lin,i) + 1 then
  185.                      if lin[i - 1] == c then break
  186.                      else i +:= 1
  187.                   else {
  188.                      i := 1
  189.                      linenum +:= 1
  190.                      lin := read(infile) | fail
  191.                      }
  192.                }
  193.             else i +:= 1
  194.             }
  195.          else if lin[i] == "#" then {    # don't xref comments; get next line
  196.             i := *lin + 1
  197.             }
  198.          else if i := many(alphas,lin,i) then
  199.             return lin[j:i]
  200.          else {
  201.             i +:= 1
  202.             return lin[i - 1]
  203.             }
  204.          }
  205.       else
  206.          i := *lin + 1
  207.    }       # repeat
  208. end
  209.  
  210. procedure format(T)
  211.    local V, block, n, L, lin, maxcol, lmargin, chunk, col
  212.    initial {
  213.       maxcol := \inmaxcol | 80
  214.       lmargin := \inlmarg | 40
  215.       chunk := \inchunk | 4
  216.       }
  217.    L := []
  218.    col := lmargin
  219.    every V := !T do
  220.       every block := !V do {
  221.          lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
  222.          every lin ||:= center(block[3 to *block],chunk," ") do {
  223.             col +:= chunk
  224.             if col >= maxcol - chunk then {
  225.                lin ||:= "\n\t\t\t\t\t"
  226.                col := lmargin
  227.                }
  228.             }
  229.          if col = lmargin then lin := lin[1:-6] # came out exactly even
  230.          put(L,lin)
  231.          col := lmargin
  232.          }
  233.    L := sort(L)
  234.    push(L,"variable\tprocedure\t\tline numbers\n")
  235.    return L
  236. end
  237.