summaryrefslogtreecommitdiff
path: root/web/noweb/src/icon/noidx.nw
diff options
context:
space:
mode:
Diffstat (limited to 'web/noweb/src/icon/noidx.nw')
-rw-r--r--web/noweb/src/icon/noidx.nw479
1 files changed, 479 insertions, 0 deletions
diff --git a/web/noweb/src/icon/noidx.nw b/web/noweb/src/icon/noidx.nw
new file mode 100644
index 0000000000..62fd9176d1
--- /dev/null
+++ b/web/noweb/src/icon/noidx.nw
@@ -0,0 +1,479 @@
+\documentstyle[noweb]{article}
+\pagestyle{noweb}\noweboptions{shortxref}
+\begin{document}
+Missing ``{\tt @xref tag} {\it label tag},'' where {\it label} is the name of
+a label and {\it tag} is a chunk number, page number, sub-page number, or
+other identifying mark.
+@
+\section{Cross-reference and index support}
+<<*>>=
+global lines # all the input lines
+global delay # non-null if markup should be delayed past the first chunk
+global anchordist # max distance before code chunk to place defining @xref label
+
+procedure main(args)
+ lines := []
+ <<initialization>>
+ delay := &null
+ <<swallow [[args]]>>
+ while put(lines, line := read()) do
+ apply(pass1, line)
+ every apply(pass2, !lines)
+ <<write trailers if not already written>>
+end
+
+procedure apply(pass, line)
+ line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null))
+end
+<<swallow [[args]]>>=
+while case(a := get(args)) of {
+ "-delay" : delay := 1
+ "-docanchor" : anchordist := integer(get(args))
+ default : fatal("unknown argument ", image(a))
+}
+@
+<<*>>=
+global curfile # unique id of the current @file
+global lastbeginarg # identifies last chunk (for -delay)
+<<initialization>>=
+curfile := "standard input?"
+lastbeginarg := "never any chunks?"
+@
+[[anchorlabel]] is the label that references to a code chunk refer to.
+The {\LaTeX} back end typically uses the chunk itself, but the HTML
+back end will use a spot in the preceding documentation chunk (if
+any), as requested by [[-docanchor]] (and non-null [[anchordist]])
+and recorded in [[anchorlabel]].
+<<*>>=
+global allchunks, allidents
+global indexlabels, defanchors, uses, anchorlabel, indexanchorlabel
+<<initialization>>=
+every allchunks | allidents := set()
+every indexlabels | defanchors | uses | anchorlabel | indexanchorlabel := table()
+@
+I set [[textnonblank]] non-null if some text line in the current chunk
+contains a non-blank character.
+This trick lets me avoid planting anchors in empty documentation chunks.
+<<*>>=
+procedure pass1(name, arg)
+ static lastdefnlabel, thisusecount, lastanchorlabel, nonblank, textnonblank
+ initial nonblank := ~' \t'
+ case name of {
+ "file" : curfile := uniqueid(arg)
+ "begin" : { lastbeginarg := arg; textnonblank := &null }
+ "end" : if match("docs ", arg) & \anchordist & \textnonblank then
+ {<<insert and set [[lastanchorlabel]]>>}
+ else
+ lastanchorlabel := &null
+ "text" : /textnonblank := upto(nonblank, arg)
+ "defn" : {
+ insert(allchunks, arg)
+ slipin("@xref label " || (lastdefnlabel := newdefnlabel(arg)))
+ /lastanchorlabel := lastdefnlabel
+ /anchorlabel[arg] := lastanchorlabel
+ addlabel(defanchors, arg, lastanchorlabel)
+ addud(chunkud, "defn", arg, lastanchorlabel)
+ thisusecount := 0
+ }
+ "use" :
+ if match ("code ", lastbeginarg) then {
+ insert(allchunks, arg)
+ slipin("@xref label " || lastdefnlabel || "-u" || (thisusecount +:= 1))
+ addlabel(uses, arg, lastanchorlabel)
+ addud(chunkud, "use", arg, lastanchorlabel)
+ } else {
+ /textnonblank := upto(nonblank, arg) # could appear in quoted code
+ }
+ "index" : {
+ <<shift [[name]] and [[arg]]>>
+ case name of {
+ "use" : { insert(allidents, arg)
+ addud(indexud, "use", arg, \lastanchorlabel)
+ }
+ "defn" | "localdefn" : {
+ insert(allidents, arg)
+ (l := \lastanchorlabel) |
+ slipin("@xref label " || (l := newdocslabel()))
+ addud(indexud, "defn", arg, l)
+ /indexanchorlabel[arg] := l
+ slipin("@xref ref " || l) # bug fix
+ }
+ }
+ }
+ }
+ return
+end
+@
+The bug fix\label{multi-def-bug}
+alluded to above occurs when there are multiple definitions of an identifier.
+In this case, we can't just use [[indexanchorlabel[id]]], because that refers only to
+the first definition. In the {\TeX} back end, that leads to bogus
+tags like \hbox{\it x \small\rm 7b 7b 7b} instead of \hbox{\it x
+\small\rm 7b 9 12a}; the first tag is repeated again and again.
+Because the tag for the current [[@defn]] is lost by the time pass~2
+rolls around, we have to slip it in on pass~1.
+@
+<<insert and set [[lastanchorlabel]]>>=
+t := []; n := anchordist
+lastanchorlabel := newdocslabel()
+while lines[-1] ?
+ if n = 0 | ="@begin docs" then
+ { put(lines, "@xref label " || lastanchorlabel); lines |||:= t; break }
+ else
+ { if ="@nl" & pos(0) then n -:= 1; push(t, pull(lines)) }
+@
+[[slipin]] sticks something into [[lines]] just before the current (last) line.
+It makes sense only on the first pass.
+<<*>>=
+procedure slipin(s)
+ local last
+ last := pull(lines)
+ every put(lines, s | last)
+ return s
+end
+<<*>>=
+procedure pass2(name, arg)
+ static thesedefns, theseuses
+ static thischunk # null for docs chunk, arg of @defn for code chunk
+ static defout # number of definitions emitted for each chunk
+ initial defout := table(0)
+ case name of {
+ "begin" : {
+ if \delay & lastbeginarg == arg then <<write trailers if not already written>>
+ <<copy [[name]] and [[arg]] to output>>
+ every thesedefns | theseuses := set()
+ thischunk := &null
+ }
+ "defn" : { thischunk := arg;
+ write("@xref ref " || anchorlabel[arg])
+ <<copy [[name]] and [[arg]] to output>>
+ <<write chunk cross-reference>>
+ }
+# must postpone index cross-reference to end of chunk because
+# the info is accumulated in [[thesdefns]] and [[theseuses]] on this pass
+ "end" : { if match("code", arg) then {<<write index cross-reference>>}
+ <<copy [[name]] and [[arg]] to output>>
+ }
+ "use" : { write("@xref ref " || (\anchorlabel[arg] | "nw@notdef")) # was "???"
+ <<copy [[name]] and [[arg]] to output>>
+ }
+ "index" : {
+ <<shift [[name]] and [[arg]]>>
+ case name of {
+ "defn" | "localdefn" : {
+ insert(thesedefns, arg)
+ # no xref ref because of bug fix
+ }
+ "use" : { insert(theseuses, arg)
+ write("@xref ref ", \indexanchorlabel[arg])
+ }
+ }
+ name := "index " || name
+ <<copy [[name]] and [[arg]] to output>>
+ }
+ "text" : # grotesque hack! for chunks and index in HTML
+ if /thischunk then # docs mode
+ case arg of {
+ "<nowebchunks>" : lognowebchunks()
+ "<nowebindex>" : lognowebindex()
+ default : <<copy [[name]] and [[arg]] to output>>
+ }
+ else <<copy [[name]] and [[arg]] to output>>
+ "fatal" : { <<copy [[name]] and [[arg]] to output>>; exit(1) }
+ "trailer" : { <<write trailers if not already written>>
+ <<copy [[name]] and [[arg]] to output>>
+ }
+ default : <<copy [[name]] and [[arg]] to output>>
+ }
+ return
+end
+@
+The case of the [[@index defn]] is the one case where we don't emit a
+reference, because the reference has to go in earlier. See
+page~\pageref{multi-def-bug} for an explanation.
+@
+<<write chunk cross-reference>>=
+defout[thischunk] +:= 1
+write("@xref prevdef ", defanchors[thischunk][defout[thischunk] - 1]) # fail if first
+write("@xref nextdef ", defanchors[thischunk][defout[thischunk] + 1]) # faif if last
+if defout[thischunk] = 1 then {<<write use and def summary for chunk cross-reference>>}
+<<write index cross-reference>>=
+theseuses --:= thesedefns
+if *thesedefns > 0 then {
+ write("@index begindefs")
+ every i := !alphasort(thesedefns) do {
+ every u := !\indexud[i] do u ? if ="use " then write("@index isused ", tab(0))
+ write("@index defitem ", i)
+ }
+ write("@index enddefs")
+}
+if *theseuses > 0 then {
+ l := alphasort(theseuses)
+ write("@index beginuses")
+ every i := !alphasort(theseuses) do {
+ every d := !\indexud[i] do d ? if ="defn " then write("@index isdefined ", tab(0))
+ write("@index useitem ", i)
+ }
+ write("@index enduses")
+}
+# every write("@literal \\nwindexuse{", TeXliteral(ident := !l), "}",
+# "{", indexlabels[ident], "}{", thislabel, "}")
+<<write use and def summary for chunk cross-reference>>=
+if *defanchors[thischunk] > 1 then {
+ write("@xref begindefs")
+ every write("@xref defitem ", defanchors[thischunk][2 to *defanchors[thischunk]])
+ write("@xref enddefs")
+}
+if \uses[thischunk] then {
+ write("@xref beginuses")
+ every write("@xref useitem ", !uses[thischunk])
+ write("@xref enduses")
+} else
+ write("@xref notused ", thischunk)
+@
+<<shift [[name]] and [[arg]]>>=
+{ arg ? { name := tab(upto(' ')|0); arg := if =" " then tab(0) else &null } }
+<<copy [[name]] and [[arg]] to output>>=
+write("@", name, (" " || \arg) | "")
+<<*>>=
+procedure lualistimage(l)
+ p := "{ "
+ s := ""
+ every i := 1 to *l do {
+ s ||:= p || "[" || i || "] = " || image(l[i])
+ p := ", "
+ }
+ return s || " }"
+end
+@
+The following code is a change first effective in version~2.10d.
+It ensures that labels are the same whether files are marked up one at
+a time or in a group.
+This change helps ``book page definition marks'' for the 152 text,
+which is processed one chapter at a time for weaving but several
+chapters in a group for tangling.
+<<*>>=
+procedure newdefnlabel(arg)
+ static defcounts
+ initial defcounts := table(0)
+ /defanchors[arg] := []
+ k := curfile || "-" || uniqueid(arg)
+ defcounts[k] +:= 1
+ return "NW" || k || "-" || alphacode(defcounts[k])
+end
+<<*>>=
+procedure newdocslabel()
+ static count
+ initial count := 0
+ return "NWD" || curfile || "-" || alphacode(count +:= 1)
+end
+<<*>>=
+procedure addlabel(tbl, arg, label)
+ /tbl[arg] := []
+ if tbl[arg][-1] == label then &null
+ else put(tbl[arg], label)
+ return label
+end
+<<*>>=
+global chunkud, indexud
+procedure addud(udlist, name, arg, label)
+ /udlist[arg] := []
+ s := name || " " || label
+ return udlist[arg][-1] == s | put(udlist[arg], s)
+end
+<<initialization>>=
+every chunkud | indexud := table();
+@
+Because it's silly to have both a use and a definition point to the same chunk,
+I strip out uses that list the same chunk as their definitions.
+<<*>>=
+procedure strip_extra_uses(udlista)
+ local old, new, item
+ old := copy(udlista)
+ new := []
+ while item := get(old) do
+ item ?
+ if ="defn " then
+ <<add item if needed>>
+ else if ="use " then
+ if "defn " || tab(0) == !(old|new) then
+ &null # write(&errout, "Stripped extra ", item)
+ else
+ <<add item if needed>>
+ return new
+end
+<<add item if needed>>=
+{ new[-1] == item | put(new, item) }
+@
+[[uniqueid]] eliminates both {\TeX} and HTML specials.
+<<*>>=
+procedure uniqueid(name)
+ local key
+ static idtable, keycounts, badchars, badstars
+ initial { idtable := table() ; keycounts := table(0)
+ badchars := ~ (&letters ++ &digits ++ '!$()*+,./:;=?@|')
+ badstars := repl("*", *badchars)
+ }
+
+ if not member(idtable, name) then {
+ # key := make_key(map(name, badchars, badstars)) # deprecated
+ key := alphacode(crc(name))
+ keycounts[key] +:= 1
+ idtable[name] := key
+ if keycounts[key] > 1 then idtable[name] ||:= "." || alphacode(keycounts[key])
+ }
+ return idtable[name]
+end
+@
+The original key routine used the FORTH heuristic on the basename:
+first three letters plus the length. This produced too many collisions.
+<<*>>=
+procedure make_key(key, len)
+ static noslash
+ initial noslash := ~ '/'
+ key ? return make_key(3(tab(upto('/')), ="/", tab(many(noslash)), pos(0)), *key) |
+ key[1+:3] || alphacode(\len | *key) |
+ key || (alphacode(\len) | "")
+end
+<<*>>=
+global wrote_trailers
+<<write trailers if not already written>>=
+(if /wrote_trailers then {
+ wrote_trailers := 1
+ write("@nl")
+ write("@nl")
+ lognowebchunks()
+ lognowebindex()
+} else &null)
+@
+Now, a special hack, so we can write this stuff in the right place on pass 2.
+<<*>>=
+procedure lognowebchunks(noheader)
+ static called
+ if \called then return
+ else called := 1
+
+ l := alphasort(allchunks)
+ write("@xref beginchunks")
+ while name := get(l) do {
+ write("@xref chunkbegin ", (\anchorlabel[name] | "nw@notdef"), " ", name)
+ every write("@xref chunk", !\chunkud[name])
+ write("@xref chunkend")
+ }
+ write("@xref endchunks")
+end
+<<*>>=
+procedure lognowebindex()
+ static called
+ if \called then return
+ else called := 1
+
+ l := alphasort(allidents)
+ write("@index beginindex")
+ while name := get(l) do {
+ write("@index entrybegin ", (\indexanchorlabel[name] | "nw@notdef"), " ", name)
+ every write("@index entry", !strip_extra_uses(\indexud[name]))
+ write("@index entryend")
+ }
+ write("@index endindex")
+end
+<<*>>=
+procedure alphasort(x)
+ t := table()
+ every s := !x do t[s] := sortkey(s)
+ t := sort(t, 2)
+ l := []
+ every put(l, (!t)[1])
+ return l
+end
+@
+I tried to ignore special characters when sorting.
+This turned out to be too clever by half.
+Sample: it would sort [[BALANCER_DEBUGGING]] before
+[[BALANCE_TRANSFORMATION]], because the underscore didn't count.
+<<old, evil code>>=
+procedure sortkey(s)
+ static keep
+ initial keep := &lcase ++ ' '
+ s := map(s)
+ r := ""
+ s ? while tab(upto(keep)) do r ||:= move(1)
+ return r || "\n" || s # relies on \n sorting lower than other chars
+end
+@ My solution is to move to a much simpler scheme in which the only
+thing we do is change case.
+<<*>>=
+procedure sortkey(s)
+ return map(s) || "\n" || s # relies on \n sorting lower than other chars
+end
+<<*>>=
+procedure alphacode(n)
+ static codes
+ initial codes := &digits || &letters
+ return if n < 0 then
+ "-" || alphacode(-n)
+ else if n >= *codes then
+ alphacode(n / *codes) || alphacode(n % *codes)
+ else
+ codes[n+1]
+end
+@
+<<*>>=
+# /* 32-bit Cyclic Redundancy Code implemented by A. Appel 1986 */
+#
+# this works only if POLY is a prime polynomial in the field
+# of integers modulo 2, of order 32. Since the representation of this
+# won't fit in a 32-bit word, the high-order bit is implicit.
+# IT MUST ALSO BE THE CASE that the coefficients of orders 31 down to 25
+# are zero. Fortunately, we have a candidate, from
+# E. J. Watson, "Primitive Polynomials (Mod 2)", Math. Comp 16 (1962).
+# It is: x^32 + x^7 + x^5 + x^3 + x^2 + x^1 + x^0
+#
+# Now we reverse the bits to get:
+# 111101010000000000000000000000001 in binary (but drop the last 1)
+# f 5 0 0 0 0 0 0 in hex
+# */
+
+procedure crc_table()
+ local POLY, sum
+ POLY := 16rf5000000
+ t := table()
+ every i := 0 to 255 do {
+ sum := 0
+ every j := 7 to 0 by -1 do
+ if iand(i, ishift(1, j)) ~= 0 then
+ sum := ixor(sum, ishift(POLY, -j))
+ t[i] := sum
+ }
+ return t
+end
+
+procedure crc(s)
+ local sum
+ static table
+ initial table := crc_table()
+ sum := 0
+ s ? while sum := ixor(ishift(sum, -8), table[iand(ixor(sum, ord(move(1))), 255)])
+ return sum
+end
+@
+<<*>>=
+procedure fatal(L[])
+ write!(["@fatal noidx "] ||| L)
+ write!([&errout, "noweb error in noidx: "] ||| L)
+ exit(1)
+end
+<<*>>=
+procedure rcsinfo ()
+ return "$Id: noidx.nw,v 1.22 2008/10/06 01:03:05 nr Exp nr $" ||
+ "$Name: v2_12 $"
+end
+@
+\section{List of chunks}
+\nowebchunks
+
+\twocolumn
+\section{Index}
+\nowebindex
+@
+\end{document}