0000: 3b 09 46 75 6e 63 74 69 6f 6e 61 6c 20 58 4d 4c ;.Functional XML
0010: 20 70 61 72 73 69 6e 67 20 66 72 61 6d 65 77 6f parsing framewo
0020: 72 6b 3a 20 53 41 58 2f 44 4f 4d 20 61 6e 64 20 rk: SAX/DOM and
0030: 53 58 4d 4c 20 70 61 72 73 65 72 73 0a 3b 09 20 SXML parsers.;.
0040: 20 20 20 20 20 77 69 74 68 20 73 75 70 70 6f 72 with suppor
0050: 74 20 66 6f 72 20 58 4d 4c 20 4e 61 6d 65 73 70 t for XML Namesp
0060: 61 63 65 73 20 61 6e 64 20 76 61 6c 69 64 61 74 aces and validat
0070: 69 6f 6e 0a 3b 0a 3b 20 54 68 69 73 20 69 73 20 ion.;.; This is
0080: 61 20 70 61 63 6b 61 67 65 20 6f 66 20 6c 6f 77 a package of low
0090: 2d 74 6f 2d 68 69 67 68 20 6c 65 76 65 6c 20 6c -to-high level l
00a0: 65 78 69 6e 67 20 61 6e 64 20 70 61 72 73 69 6e exing and parsin
00b0: 67 20 70 72 6f 63 65 64 75 72 65 73 0a 3b 20 74 g procedures.; t
00c0: 68 61 74 20 63 61 6e 20 62 65 20 63 6f 6d 62 69 hat can be combi
00d0: 6e 65 64 20 74 6f 20 79 69 65 6c 64 20 61 20 53 ned to yield a S
00e0: 41 58 2c 20 61 20 44 4f 4d 2c 20 61 20 76 61 6c AX, a DOM, a val
00f0: 69 64 61 74 69 6e 67 20 70 61 72 73 65 72 73 2c idating parsers,
0100: 20 6f 72 0a 3b 20 61 20 70 61 72 73 65 72 20 69 or.; a parser i
0110: 6e 74 65 6e 64 65 64 20 66 6f 72 20 61 20 70 61 ntended for a pa
0120: 72 74 69 63 75 6c 61 72 20 64 6f 63 75 6d 65 6e rticular documen
0130: 74 20 74 79 70 65 2e 20 54 68 65 20 70 72 6f 63 t type. The proc
0140: 65 64 75 72 65 73 20 69 6e 0a 3b 20 74 68 65 20 edures in.; the
0150: 70 61 63 6b 61 67 65 20 63 61 6e 20 62 65 20 75 package can be u
0160: 73 65 64 20 73 65 70 61 72 61 74 65 6c 79 20 74 sed separately t
0170: 6f 20 74 6f 6b 65 6e 69 7a 65 20 6f 72 20 70 61 o tokenize or pa
0180: 72 73 65 20 76 61 72 69 6f 75 73 0a 3b 20 70 69 rse various.; pi
0190: 65 63 65 73 20 6f 66 20 58 4d 4c 20 64 6f 63 75 eces of XML docu
01a0: 6d 65 6e 74 73 2e 20 54 68 65 20 70 61 63 6b 61 ments. The packa
01b0: 67 65 20 73 75 70 70 6f 72 74 73 20 58 4d 4c 20 ge supports XML
01c0: 4e 61 6d 65 73 70 61 63 65 73 2c 0a 3b 20 69 6e Namespaces,.; in
01d0: 74 65 72 6e 61 6c 20 61 6e 64 20 65 78 74 65 72 ternal and exter
01e0: 6e 61 6c 20 70 61 72 73 65 64 20 65 6e 74 69 74 nal parsed entit
01f0: 69 65 73 2c 20 75 73 65 72 2d 63 6f 6e 74 72 6f ies, user-contro
0200: 6c 6c 65 64 20 68 61 6e 64 6c 69 6e 67 20 6f 66 lled handling of
0210: 0a 3b 20 77 68 69 74 65 73 70 61 63 65 2c 20 61 .; whitespace, a
0220: 6e 64 20 76 61 6c 69 64 61 74 69 6f 6e 2e 20 54 nd validation. T
0230: 68 69 73 20 6d 6f 64 75 6c 65 20 74 68 65 72 65 his module there
0240: 66 6f 72 65 20 69 73 20 69 6e 74 65 6e 64 65 64 fore is intended
0250: 20 74 6f 20 62 65 0a 3b 20 61 20 66 72 61 6d 65 to be.; a frame
0260: 77 6f 72 6b 2c 20 61 20 73 65 74 20 6f 66 20 22 work, a set of "
0270: 4c 65 67 6f 20 62 6c 6f 63 6b 73 22 20 79 6f 75 Lego blocks" you
0280: 20 63 61 6e 20 75 73 65 20 74 6f 20 62 75 69 6c can use to buil
0290: 64 20 61 20 70 61 72 73 65 72 0a 3b 20 66 6f 6c d a parser.; fol
02a0: 6c 6f 77 69 6e 67 20 61 6e 79 20 64 69 73 63 69 lowing any disci
02b0: 70 6c 69 6e 65 20 61 6e 64 20 70 65 72 66 6f 72 pline and perfor
02c0: 6d 69 6e 67 20 76 61 6c 69 64 61 74 69 6f 6e 20 ming validation
02d0: 74 6f 20 61 6e 79 20 64 65 67 72 65 65 2e 20 41 to any degree. A
02e0: 73 0a 3b 20 61 6e 20 65 78 61 6d 70 6c 65 20 6f s.; an example o
02f0: 66 20 74 68 65 20 70 61 72 73 65 72 20 63 6f 6e f the parser con
0300: 73 74 72 75 63 74 69 6f 6e 2c 20 74 68 69 73 20 struction, this
0310: 66 69 6c 65 20 69 6e 63 6c 75 64 65 73 20 61 0a file includes a.
0320: 3b 20 73 65 6d 69 2d 76 61 6c 69 64 61 74 69 6e ; semi-validatin
0330: 67 20 53 58 4d 4c 20 70 61 72 73 65 72 2e 0a 0a g SXML parser...
0340: 3b 20 54 68 65 20 70 72 65 73 65 6e 74 20 58 4d ; The present XM
0350: 4c 20 66 72 61 6d 65 77 6f 72 6b 20 68 61 73 20 L framework has
0360: 61 20 22 73 65 71 75 65 6e 74 69 61 6c 22 20 66 a "sequential" f
0370: 65 65 6c 20 6f 66 20 53 41 58 20 79 65 74 20 61 eel of SAX yet a
0380: 0a 3b 20 22 66 75 6e 63 74 69 6f 6e 61 6c 20 73 .; "functional s
0390: 74 79 6c 65 22 20 6f 66 20 44 4f 4d 2e 20 4c 69 tyle" of DOM. Li
03a0: 6b 65 20 61 20 53 41 58 20 70 61 72 73 65 72 2c ke a SAX parser,
03b0: 20 74 68 65 20 66 72 61 6d 65 77 6f 72 6b 20 73 the framework s
03c0: 63 61 6e 73 0a 3b 20 74 68 65 20 64 6f 63 75 6d cans.; the docum
03d0: 65 6e 74 20 6f 6e 6c 79 20 6f 6e 63 65 20 61 6e ent only once an
03e0: 64 20 70 65 72 6d 69 74 73 20 69 6e 63 72 65 6d d permits increm
03f0: 65 6e 74 61 6c 20 70 72 6f 63 65 73 73 69 6e 67 ental processing
0400: 2e 20 41 6e 0a 3b 20 61 70 70 6c 69 63 61 74 69 . An.; applicati
0410: 6f 6e 20 74 68 61 74 20 68 61 6e 64 6c 65 73 20 on that handles
0420: 64 6f 63 75 6d 65 6e 74 20 65 6c 65 6d 65 6e 74 document element
0430: 73 20 69 6e 20 6f 72 64 65 72 20 63 61 6e 20 72 s in order can r
0440: 75 6e 20 61 73 0a 3b 20 65 66 66 69 63 69 65 6e un as.; efficien
0450: 74 6c 79 20 61 73 20 70 6f 73 73 69 62 6c 65 2e tly as possible.
0460: 20 5f 55 6e 6c 69 6b 65 5f 20 61 20 53 41 58 20 _Unlike_ a SAX
0470: 70 61 72 73 65 72 2c 20 74 68 65 20 66 72 61 6d parser, the fram
0480: 65 77 6f 72 6b 20 64 6f 65 73 0a 3b 20 6e 6f 74 ework does.; not
0490: 20 72 65 71 75 69 72 65 20 61 6e 20 61 70 70 6c require an appl
04a0: 69 63 61 74 69 6f 6e 20 72 65 67 69 73 74 65 72 ication register
04b0: 20 73 74 61 74 65 66 75 6c 20 63 61 6c 6c 62 61 stateful callba
04c0: 63 6b 73 20 61 6e 64 20 73 75 72 72 65 6e 64 65 cks and surrende
04d0: 72 0a 3b 20 63 6f 6e 74 72 6f 6c 20 74 6f 20 74 r.; control to t
04e0: 68 65 20 70 61 72 73 65 72 2e 20 52 61 74 68 65 he parser. Rathe
04f0: 72 2c 20 69 74 20 69 73 20 74 68 65 20 61 70 70 r, it is the app
0500: 6c 69 63 61 74 69 6f 6e 20 74 68 61 74 20 63 61 lication that ca
0510: 6e 20 64 72 69 76 65 0a 3b 20 74 68 65 20 66 72 n drive.; the fr
0520: 61 6d 65 77 6f 72 6b 20 2d 2d 20 63 61 6c 6c 69 amework -- calli
0530: 6e 67 20 69 74 73 20 66 75 6e 63 74 69 6f 6e 73 ng its functions
0540: 20 74 6f 20 67 65 74 20 74 68 65 20 63 75 72 72 to get the curr
0550: 65 6e 74 20 6c 65 78 69 63 61 6c 20 6f 72 0a 3b ent lexical or.;
0560: 20 73 79 6e 74 61 78 20 65 6c 65 6d 65 6e 74 2e syntax element.
0570: 20 54 68 65 73 65 20 66 75 6e 63 74 69 6f 6e 73 These functions
0580: 20 64 6f 20 6e 6f 74 20 6d 61 69 6e 74 61 69 6e do not maintain
0590: 20 6f 72 20 6d 75 74 61 74 65 20 61 6e 79 20 73 or mutate any s
05a0: 74 61 74 65 0a 3b 20 73 61 76 65 20 74 68 65 20 tate.; save the
05b0: 69 6e 70 75 74 20 70 6f 72 74 2e 20 54 68 65 72 input port. Ther
05c0: 65 66 6f 72 65 2c 20 74 68 65 20 66 72 61 6d 65 efore, the frame
05d0: 77 6f 72 6b 20 70 65 72 6d 69 74 73 20 70 61 72 work permits par
05e0: 73 69 6e 67 20 6f 66 20 58 4d 4c 0a 3b 20 69 6e sing of XML.; in
05f0: 20 61 20 70 75 72 65 20 66 75 6e 63 74 69 6f 6e a pure function
0600: 61 6c 20 73 74 79 6c 65 2c 20 77 69 74 68 20 74 al style, with t
0610: 68 65 20 69 6e 70 75 74 20 70 6f 72 74 20 62 65 he input port be
0620: 69 6e 67 20 61 20 6d 6f 6e 61 64 20 28 6f 72 20 ing a monad (or
0630: 61 0a 3b 20 6c 69 6e 65 61 72 2c 20 72 65 61 64 a.; linear, read
0640: 2d 6f 6e 63 65 20 70 61 72 61 6d 65 74 65 72 29 -once parameter)
0650: 2e 0a 0a 3b 20 42 65 73 69 64 65 73 20 74 68 65 ...; Besides the
0660: 20 50 4f 52 54 2c 20 74 68 65 72 65 20 69 73 20 PORT, there is
0670: 61 6e 6f 74 68 65 72 20 6d 6f 6e 61 64 20 2d 2d another monad --
0680: 20 53 45 45 44 2e 20 4d 6f 73 74 20 6f 66 20 74 SEED. Most of t
0690: 68 65 0a 3b 20 6d 69 64 64 6c 65 2d 20 61 6e 64 he.; middle- and
06a0: 20 68 69 67 68 2d 6c 65 76 65 6c 20 70 61 72 73 high-level pars
06b0: 65 72 73 20 61 72 65 20 73 69 6e 67 6c 65 2d 74 ers are single-t
06c0: 68 72 65 61 64 65 64 20 74 68 72 6f 75 67 68 20 hreaded through
06d0: 74 68 65 0a 3b 20 73 65 65 64 2e 20 54 68 65 20 the.; seed. The
06e0: 66 75 6e 63 74 69 6f 6e 73 20 6f 66 20 74 68 69 functions of thi
06f0: 73 20 66 72 61 6d 65 77 6f 72 6b 20 64 6f 20 6e s framework do n
0700: 6f 74 20 70 72 6f 63 65 73 73 20 6f 72 20 61 66 ot process or af
0710: 66 65 63 74 20 74 68 65 0a 3b 20 53 45 45 44 20 fect the.; SEED
0720: 69 6e 20 61 6e 79 20 77 61 79 3a 20 74 68 65 79 in any way: they
0730: 20 73 69 6d 70 6c 79 20 70 61 73 73 20 69 74 20 simply pass it
0740: 61 72 6f 75 6e 64 20 61 73 20 61 6e 20 69 6e 73 around as an ins
0750: 74 61 6e 63 65 20 6f 66 20 61 6e 0a 3b 20 6f 70 tance of an.; op
0760: 61 71 75 65 20 64 61 74 61 74 79 70 65 2e 20 20 aque datatype.
0770: 55 73 65 72 20 66 75 6e 63 74 69 6f 6e 73 2c 20 User functions,
0780: 6f 6e 20 74 68 65 20 6f 74 68 65 72 20 68 61 6e on the other han
0790: 64 2c 20 63 61 6e 20 75 73 65 20 74 68 65 0a 3b d, can use the.;
07a0: 20 73 65 65 64 20 74 6f 20 6d 61 69 6e 74 61 69 seed to maintai
07b0: 6e 20 75 73 65 72 27 73 20 73 74 61 74 65 2c 20 n user's state,
07c0: 74 6f 20 61 63 63 75 6d 75 6c 61 74 65 20 70 61 to accumulate pa
07d0: 72 73 69 6e 67 20 72 65 73 75 6c 74 73 2c 20 65 rsing results, e
07e0: 74 63 2e 20 41 0a 3b 20 75 73 65 72 20 63 61 6e tc. A.; user can
07f0: 20 66 72 65 65 6c 79 20 6d 69 78 20 68 69 73 20 freely mix his
0800: 6f 77 6e 20 66 75 6e 63 74 69 6f 6e 73 20 77 69 own functions wi
0810: 74 68 20 74 68 6f 73 65 20 6f 66 20 74 68 65 0a th those of the.
0820: 3b 20 66 72 61 6d 65 77 6f 72 6b 2e 20 4f 6e 20 ; framework. On
0830: 74 68 65 20 6f 74 68 65 72 20 68 61 6e 64 2c 20 the other hand,
0840: 74 68 65 20 75 73 65 72 20 6d 61 79 20 77 69 73 the user may wis
0850: 68 20 74 6f 20 69 6e 73 74 61 6e 74 69 61 74 65 h to instantiate
0860: 20 61 0a 3b 20 68 69 67 68 2d 6c 65 76 65 6c 20 a.; high-level
0870: 70 61 72 73 65 72 3a 20 73 73 61 78 3a 6d 61 6b parser: ssax:mak
0880: 65 2d 65 6c 65 6d 2d 70 61 72 73 65 72 20 6f 72 e-elem-parser or
0890: 20 73 73 61 78 3a 6d 61 6b 65 2d 70 61 72 73 65 ssax:make-parse
08a0: 72 2e 20 20 49 6e 0a 3b 20 74 68 65 20 6c 61 74 r. In.; the lat
08b0: 74 65 72 20 63 61 73 65 2c 20 74 68 65 20 75 73 ter case, the us
08c0: 65 72 20 6d 75 73 74 20 70 72 6f 76 69 64 65 20 er must provide
08d0: 66 75 6e 63 74 69 6f 6e 73 20 6f 66 20 73 70 65 functions of spe
08e0: 63 69 66 69 63 0a 3b 20 73 69 67 6e 61 74 75 72 cific.; signatur
08f0: 65 73 2c 20 77 68 69 63 68 20 61 72 65 20 63 61 es, which are ca
0900: 6c 6c 65 64 20 61 74 20 70 72 65 64 69 63 74 61 lled at predicta
0910: 62 6c 65 20 6d 6f 6d 65 6e 74 73 20 64 75 72 69 ble moments duri
0920: 6e 67 20 74 68 65 0a 3b 20 70 61 72 73 69 6e 67 ng the.; parsing
0930: 3a 20 74 6f 20 68 61 6e 64 6c 65 20 63 68 61 72 : to handle char
0940: 61 63 74 65 72 20 64 61 74 61 2c 20 65 6c 65 6d acter data, elem
0950: 65 6e 74 20 64 61 74 61 2c 20 6f 72 20 70 72 6f ent data, or pro
0960: 63 65 73 73 69 6e 67 0a 3b 20 69 6e 73 74 72 75 cessing.; instru
0970: 63 74 69 6f 6e 73 20 28 50 49 29 2e 20 54 68 65 ctions (PI). The
0980: 20 66 75 6e 63 74 69 6f 6e 73 20 61 72 65 20 61 functions are a
0990: 6c 77 61 79 73 20 67 69 76 65 6e 20 74 68 65 20 lways given the
09a0: 53 45 45 44 2c 20 61 6d 6f 6e 67 0a 3b 20 6f 74 SEED, among.; ot
09b0: 68 65 72 20 70 61 72 61 6d 65 74 65 72 73 2c 20 her parameters,
09c0: 61 6e 64 20 6d 75 73 74 20 72 65 74 75 72 6e 20 and must return
09d0: 74 68 65 20 6e 65 77 20 53 45 45 44 2e 0a 0a 3b the new SEED...;
09e0: 20 46 72 6f 6d 20 61 20 66 75 6e 63 74 69 6f 6e From a function
09f0: 61 6c 20 70 6f 69 6e 74 20 6f 66 20 76 69 65 77 al point of view
0a00: 2c 20 58 4d 4c 20 70 61 72 73 69 6e 67 20 69 73 , XML parsing is
0a10: 20 61 20 63 6f 6d 62 69 6e 65 64 0a 3b 20 70 72 a combined.; pr
0a20: 65 2d 70 6f 73 74 2d 6f 72 64 65 72 20 74 72 61 e-post-order tra
0a30: 76 65 72 73 61 6c 20 6f 66 20 61 20 22 74 72 65 versal of a "tre
0a40: 65 22 20 74 68 61 74 20 69 73 20 74 68 65 20 58 e" that is the X
0a50: 4d 4c 20 64 6f 63 75 6d 65 6e 74 0a 3b 20 69 74 ML document.; it
0a60: 73 65 6c 66 2e 20 54 68 69 73 20 64 6f 77 6e 2d self. This down-
0a70: 61 6e 64 2d 75 70 20 74 72 61 76 65 72 73 61 6c and-up traversal
0a80: 20 74 65 6c 6c 73 20 74 68 65 20 75 73 65 72 20 tells the user
0a90: 61 62 6f 75 74 20 61 6e 20 65 6c 65 6d 65 6e 74 about an element
0aa0: 0a 3b 20 77 68 65 6e 20 69 74 73 20 73 74 61 72 .; when its star
0ab0: 74 20 74 61 67 20 69 73 20 65 6e 63 6f 75 6e 74 t tag is encount
0ac0: 65 72 65 64 2e 20 54 68 65 20 75 73 65 72 20 69 ered. The user i
0ad0: 73 20 6e 6f 74 69 66 69 65 64 20 61 62 6f 75 74 s notified about
0ae0: 20 74 68 65 0a 3b 20 65 6c 65 6d 65 6e 74 20 6f the.; element o
0af0: 6e 63 65 20 6d 6f 72 65 2c 20 61 66 74 65 72 20 nce more, after
0b00: 61 6c 6c 20 65 6c 65 6d 65 6e 74 27 73 20 63 68 all element's ch
0b10: 69 6c 64 72 65 6e 20 68 61 76 65 20 62 65 65 6e ildren have been
0b20: 0a 3b 20 68 61 6e 64 6c 65 64 2e 20 54 68 65 20 .; handled. The
0b30: 70 72 6f 63 65 73 73 20 6f 66 20 58 4d 4c 20 70 process of XML p
0b40: 61 72 73 69 6e 67 20 74 68 65 72 65 66 6f 72 65 arsing therefore
0b50: 20 69 73 20 61 20 66 6f 6c 64 20 6f 76 65 72 20 is a fold over
0b60: 74 68 65 0a 3b 20 72 61 77 20 58 4d 4c 20 64 6f the.; raw XML do
0b70: 63 75 6d 65 6e 74 2e 20 55 6e 6c 69 6b 65 20 61 cument. Unlike a
0b80: 20 66 6f 6c 64 20 6f 76 65 72 20 74 72 65 65 73 fold over trees
0b90: 20 64 65 66 69 6e 65 64 20 69 6e 20 5b 31 5d 2c defined in [1],
0ba0: 20 74 68 65 0a 3b 20 70 61 72 73 65 72 20 69 73 the.; parser is
0bb0: 20 6e 65 63 65 73 73 61 72 69 6c 79 20 73 69 6e necessarily sin
0bc0: 67 6c 65 2d 74 68 72 65 61 64 65 64 20 2d 2d 20 gle-threaded --
0bd0: 6f 62 76 69 6f 75 73 6c 79 20 61 73 20 65 6c 65 obviously as ele
0be0: 6d 65 6e 74 73 0a 3b 20 69 6e 20 61 20 74 65 78 ments.; in a tex
0bf0: 74 20 58 4d 4c 20 64 6f 63 75 6d 65 6e 74 20 61 t XML document a
0c00: 72 65 20 6c 61 69 64 20 64 6f 77 6e 20 73 65 71 re laid down seq
0c10: 75 65 6e 74 69 61 6c 6c 79 2e 20 54 68 65 20 70 uentially. The p
0c20: 61 72 73 65 72 0a 3b 20 74 68 65 72 65 66 6f 72 arser.; therefor
0c30: 65 20 69 73 20 61 20 74 72 65 65 20 66 6f 6c 64 e is a tree fold
0c40: 20 74 68 61 74 20 68 61 73 20 62 65 65 6e 20 74 that has been t
0c50: 72 61 6e 73 66 6f 72 6d 65 64 20 74 6f 20 61 63 ransformed to ac
0c60: 63 65 70 74 20 61 6e 0a 3b 20 61 63 63 75 6d 75 cept an.; accumu
0c70: 6c 61 74 69 6e 67 20 70 61 72 61 6d 65 74 65 72 lating parameter
0c80: 20 5b 31 2c 32 5d 2e 0a 0a 3b 20 46 6f 72 6d 61 [1,2]...; Forma
0c90: 6c 6c 79 2c 20 74 68 65 20 64 65 6e 6f 74 61 74 lly, the denotat
0ca0: 69 6f 6e 61 6c 20 73 65 6d 61 6e 74 69 63 73 20 ional semantics
0cb0: 6f 66 20 74 68 65 20 70 61 72 73 65 72 20 63 61 of the parser ca
0cc0: 6e 20 62 65 20 65 78 70 72 65 73 73 65 64 0a 3b n be expressed.;
0cd0: 20 61 73 0a 3b 20 70 61 72 73 65 72 3a 3a 20 28 as.; parser:: (
0ce0: 53 74 61 72 74 2d 74 61 67 20 2d 3e 20 53 65 65 Start-tag -> See
0cf0: 64 20 2d 3e 20 53 65 65 64 29 20 2d 3e 0a 3b 09 d -> Seed) ->.;.
0d00: 20 20 20 28 53 74 61 72 74 2d 74 61 67 20 2d 3e (Start-tag ->
0d10: 20 53 65 65 64 20 2d 3e 20 53 65 65 64 20 2d 3e Seed -> Seed ->
0d20: 20 53 65 65 64 29 20 2d 3e 0a 3b 09 20 20 20 28 Seed) ->.;. (
0d30: 43 68 61 72 2d 44 61 74 61 20 2d 3e 20 53 65 65 Char-Data -> See
0d40: 64 20 2d 3e 20 53 65 65 64 29 20 2d 3e 0a 3b 09 d -> Seed) ->.;.
0d50: 20 20 20 58 4d 4c 2d 74 65 78 74 2d 66 72 61 67 XML-text-frag
0d60: 6d 65 6e 74 20 2d 3e 20 53 65 65 64 20 2d 3e 20 ment -> Seed ->
0d70: 53 65 65 64 0a 3b 20 70 61 72 73 65 72 20 66 64 Seed.; parser fd
0d80: 6f 77 6e 20 66 75 70 20 66 63 68 61 72 20 22 3c own fup fchar "<
0d90: 65 6c 65 6d 20 61 74 74 72 73 3e 20 63 6f 6e 74 elem attrs> cont
0da0: 65 6e 74 20 3c 2f 65 6c 65 6d 3e 22 20 73 65 65 ent </elem>" see
0db0: 64 0a 3b 20 20 3d 20 66 75 70 20 22 3c 65 6c 65 d.; = fup "<ele
0dc0: 6d 20 61 74 74 72 73 3e 22 20 73 65 65 64 0a 3b m attrs>" seed.;
0dd0: 09 28 70 61 72 73 65 72 20 66 64 6f 77 6e 20 66 .(parser fdown f
0de0: 75 70 20 66 63 68 61 72 20 22 63 6f 6e 74 65 6e up fchar "conten
0df0: 74 22 20 28 66 64 6f 77 6e 20 22 3c 65 6c 65 6d t" (fdown "<elem
0e00: 20 61 74 74 72 73 3e 22 20 73 65 65 64 29 29 0a attrs>" seed)).
0e10: 3b 0a 3b 20 70 61 72 73 65 72 20 66 64 6f 77 6e ;.; parser fdown
0e20: 20 66 75 70 20 66 63 68 61 72 20 22 63 68 61 72 fup fchar "char
0e30: 2d 64 61 74 61 20 63 6f 6e 74 65 6e 74 22 20 73 -data content" s
0e40: 65 65 64 0a 3b 20 20 3d 20 70 61 72 73 65 72 20 eed.; = parser
0e50: 66 64 6f 77 6e 20 66 75 70 20 66 63 68 61 72 20 fdown fup fchar
0e60: 22 63 6f 6e 74 65 6e 74 22 20 28 66 63 68 61 72 "content" (fchar
0e70: 20 22 63 68 61 72 2d 64 61 74 61 22 20 73 65 65 "char-data" see
0e80: 64 29 0a 3b 0a 3b 20 70 61 72 73 65 72 20 66 64 d).;.; parser fd
0e90: 6f 77 6e 20 66 75 70 20 66 63 68 61 72 20 22 65 own fup fchar "e
0ea0: 6c 65 6d 2d 63 6f 6e 74 65 6e 74 20 63 6f 6e 74 lem-content cont
0eb0: 65 6e 74 22 20 73 65 65 64 0a 3b 20 20 3d 20 70 ent" seed.; = p
0ec0: 61 72 73 65 72 20 66 64 6f 77 6e 20 66 75 70 20 arser fdown fup
0ed0: 66 63 68 61 72 20 22 63 6f 6e 74 65 6e 74 22 20 fchar "content"
0ee0: 28 0a 3b 09 70 61 72 73 65 72 20 66 64 6f 77 6e (.;.parser fdown
0ef0: 20 66 75 70 20 66 63 68 61 72 20 22 65 6c 65 6d fup fchar "elem
0f00: 2d 63 6f 6e 74 65 6e 74 22 20 73 65 65 64 29 0a -content" seed).
0f10: 0a 3b 20 43 6f 6d 70 61 72 65 20 74 68 65 20 6c .; Compare the l
0f20: 61 73 74 20 74 77 6f 20 65 71 75 61 74 69 6f 6e ast two equation
0f30: 73 20 77 69 74 68 20 74 68 65 20 6c 65 66 74 20 s with the left
0f40: 66 6f 6c 64 0a 3b 20 66 6f 6c 64 2d 6c 65 66 74 fold.; fold-left
0f50: 20 6b 6f 6e 73 20 65 6c 65 6d 3a 6c 69 73 74 20 kons elem:list
0f60: 73 65 65 64 20 3d 20 66 6f 6c 64 2d 6c 65 66 74 seed = fold-left
0f70: 20 6b 6f 6e 73 20 6c 69 73 74 20 28 6b 6f 6e 73 kons list (kons
0f80: 20 65 6c 65 6d 20 73 65 65 64 29 0a 0a 3b 20 54 elem seed)..; T
0f90: 68 65 20 72 65 61 6c 20 70 61 72 73 65 72 20 63 he real parser c
0fa0: 72 65 61 74 65 64 20 6d 79 20 73 73 61 78 3a 6d reated my ssax:m
0fb0: 61 6b 65 2d 70 61 72 73 65 72 20 69 73 20 73 6c ake-parser is sl
0fc0: 69 67 68 74 6c 79 20 6d 6f 72 65 20 63 6f 6d 70 ightly more comp
0fd0: 6c 69 63 61 74 65 64 2c 0a 3b 20 74 6f 20 61 63 licated,.; to ac
0fe0: 63 6f 75 6e 74 20 66 6f 72 20 70 72 6f 63 65 73 count for proces
0ff0: 73 69 6e 67 20 69 6e 73 74 72 75 63 74 69 6f 6e sing instruction
1000: 73 2c 20 65 6e 74 69 74 79 20 72 65 66 65 72 65 s, entity refere
1010: 6e 63 65 73 2c 20 6e 61 6d 65 73 70 61 63 65 73 nces, namespaces
1020: 2c 0a 3b 20 70 72 6f 63 65 73 73 69 6e 67 20 6f ,.; processing o
1030: 66 20 64 6f 63 75 6d 65 6e 74 20 74 79 70 65 20 f document type
1040: 64 65 63 6c 61 72 61 74 69 6f 6e 2c 20 65 74 63 declaration, etc
1050: 2e 0a 0a 0a 3b 20 54 68 65 20 58 4d 4c 20 73 74 ....; The XML st
1060: 61 6e 64 61 72 64 20 64 6f 63 75 6d 65 6e 74 20 andard document
1070: 72 65 66 65 72 72 65 64 20 74 6f 20 69 6e 20 74 referred to in t
1080: 68 69 73 20 6d 6f 64 75 6c 65 20 69 73 0a 3b 09 his module is.;.
1090: 68 74 74 70 3a 2f 2f 77 77 77 2e 77 33 2e 6f 72 http://www.w3.or
10a0: 67 2f 54 52 2f 31 39 39 38 2f 52 45 43 2d 78 6d g/TR/1998/REC-xm
10b0: 6c 2d 31 39 39 38 30 32 31 30 2e 68 74 6d 6c 0a l-19980210.html.
10c0: 3b 0a 3b 20 54 68 65 20 70 72 65 73 65 6e 74 20 ;.; The present
10d0: 66 69 6c 65 20 61 6c 73 6f 20 64 65 66 69 6e 65 file also define
10e0: 73 20 61 20 70 72 6f 63 65 64 75 72 65 20 74 68 s a procedure th
10f0: 61 74 20 70 61 72 73 65 73 20 74 68 65 20 74 65 at parses the te
1100: 78 74 20 6f 66 20 61 6e 0a 3b 20 58 4d 4c 20 64 xt of an.; XML d
1110: 6f 63 75 6d 65 6e 74 20 6f 72 20 6f 66 20 61 20 ocument or of a
1120: 73 65 70 61 72 61 74 65 20 65 6c 65 6d 65 6e 74 separate element
1130: 20 69 6e 74 6f 20 53 58 4d 4c 2c 20 61 6e 0a 3b into SXML, an.;
1140: 20 53 2d 65 78 70 72 65 73 73 69 6f 6e 2d 62 61 S-expression-ba
1150: 73 65 64 20 6d 6f 64 65 6c 20 6f 66 20 61 6e 20 sed model of an
1160: 58 4d 4c 20 49 6e 66 6f 72 6d 61 74 69 6f 6e 20 XML Information
1170: 53 65 74 2e 20 53 58 4d 4c 20 69 73 20 61 6c 73 Set. SXML is als
1180: 6f 20 61 6e 0a 3b 20 41 62 73 74 72 61 63 74 20 o an.; Abstract
1190: 53 79 6e 74 61 78 20 54 72 65 65 20 6f 66 20 61 Syntax Tree of a
11a0: 6e 20 58 4d 4c 20 64 6f 63 75 6d 65 6e 74 2e 20 n XML document.
11b0: 53 58 4d 4c 20 69 73 20 73 69 6d 69 6c 61 72 0a SXML is similar.
11c0: 3b 20 62 75 74 20 6e 6f 74 20 69 64 65 6e 74 69 ; but not identi
11d0: 63 61 6c 20 74 6f 20 44 4f 4d 3b 20 53 58 4d 4c cal to DOM; SXML
11e0: 20 69 73 20 70 61 72 74 69 63 75 6c 61 72 6c 79 is particularly
11f0: 20 73 75 69 74 61 62 6c 65 20 66 6f 72 0a 3b 20 suitable for.;
1200: 53 63 68 65 6d 65 2d 62 61 73 65 64 20 58 4d 4c Scheme-based XML
1210: 2f 48 54 4d 4c 20 61 75 74 68 6f 72 69 6e 67 2c /HTML authoring,
1220: 20 53 58 50 61 74 68 20 71 75 65 72 69 65 73 2c SXPath queries,
1230: 20 61 6e 64 20 74 72 65 65 0a 3b 20 74 72 61 6e and tree.; tran
1240: 73 66 6f 72 6d 61 74 69 6f 6e 73 2e 20 53 65 65 sformations. See
1250: 20 53 58 4d 4c 2e 68 74 6d 6c 20 66 6f 72 20 6d SXML.html for m
1260: 6f 72 65 20 64 65 74 61 69 6c 73 2e 0a 3b 20 53 ore details..; S
1270: 58 4d 4c 20 69 73 20 61 20 74 65 72 6d 20 69 6d XML is a term im
1280: 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 6f 66 20 plementation of
1290: 65 76 61 6c 75 61 74 69 6f 6e 20 6f 66 20 74 68 evaluation of th
12a0: 65 20 58 4d 4c 20 64 6f 63 75 6d 65 6e 74 20 5b e XML document [
12b0: 33 5d 2e 0a 3b 20 54 68 65 20 6f 74 68 65 72 20 3]..; The other
12c0: 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 69 implementation i
12d0: 73 20 63 6f 6e 74 65 78 74 2d 70 61 73 73 69 6e s context-passin
12e0: 67 2e 0a 0a 3b 20 54 68 65 20 70 72 65 73 65 6e g...; The presen
12f0: 74 20 66 72 61 6d 65 77 6f 72 6b 73 20 66 75 6c t frameworks ful
1300: 6c 79 20 73 75 70 70 6f 72 74 73 20 74 68 65 20 ly supports the
1310: 58 4d 4c 20 4e 61 6d 65 73 70 61 63 65 73 20 52 XML Namespaces R
1320: 65 63 6f 6d 6d 65 6e 64 61 74 69 6f 6e 3a 0a 3b ecommendation:.;
1330: 09 68 74 74 70 3a 2f 2f 77 77 77 2e 77 33 2e 6f .http://www.w3.o
1340: 72 67 2f 54 52 2f 52 45 43 2d 78 6d 6c 2d 6e 61 rg/TR/REC-xml-na
1350: 6d 65 73 2f 0a 3b 20 4f 74 68 65 72 20 6c 69 6e mes/.; Other lin
1360: 6b 73 3a 0a 3b 20 5b 31 5d 20 4a 65 72 65 6d 79 ks:.; [1] Jeremy
1370: 20 47 69 62 62 6f 6e 73 2c 20 47 65 72 61 69 6e Gibbons, Gerain
1380: 74 20 4a 6f 6e 65 73 2c 20 22 54 68 65 20 55 6e t Jones, "The Un
1390: 64 65 72 2d 61 70 70 72 65 63 69 61 74 65 64 20 der-appreciated
13a0: 55 6e 66 6f 6c 64 2c 22 0a 3b 20 50 72 6f 63 2e Unfold,".; Proc.
13b0: 20 49 43 46 50 27 39 38 2c 20 31 39 39 38 2c 20 ICFP'98, 1998,
13c0: 70 70 2e 20 32 37 33 2d 32 37 39 2e 0a 3b 20 5b pp. 273-279..; [
13d0: 32 5d 20 52 69 63 68 61 72 64 20 53 2e 20 42 69 2] Richard S. Bi
13e0: 72 64 2c 20 54 68 65 20 70 72 6f 6d 6f 74 69 6f rd, The promotio
13f0: 6e 20 61 6e 64 20 61 63 63 75 6d 75 6c 61 74 69 n and accumulati
1400: 6f 6e 20 73 74 72 61 74 65 67 69 65 73 20 69 6e on strategies in
1410: 0a 3b 20 74 72 61 6e 73 66 6f 72 6d 61 74 69 6f .; transformatio
1420: 6e 61 6c 20 70 72 6f 67 72 61 6d 6d 69 6e 67 2c nal programming,
1430: 20 41 43 4d 20 54 72 61 6e 73 2e 20 50 72 6f 67 ACM Trans. Prog
1440: 72 2e 20 4c 61 6e 67 2e 20 53 79 73 74 65 6d 73 r. Lang. Systems
1450: 2c 0a 3b 20 36 28 34 29 3a 34 38 37 2d 35 30 34 ,.; 6(4):487-504
1460: 2c 20 4f 63 74 6f 62 65 72 20 31 39 38 34 2e 0a , October 1984..
1470: 3b 20 5b 33 5d 20 52 61 6c 66 20 48 69 6e 7a 65 ; [3] Ralf Hinze
1480: 2c 20 22 44 65 72 69 76 69 6e 67 20 42 61 63 6b , "Deriving Back
1490: 74 72 61 63 6b 69 6e 67 20 4d 6f 6e 61 64 20 54 tracking Monad T
14a0: 72 61 6e 73 66 6f 72 6d 65 72 73 2c 22 0a 3b 20 ransformers,".;
14b0: 46 75 6e 63 74 69 6f 6e 61 6c 20 50 65 61 72 6c Functional Pearl
14c0: 2e 20 50 72 6f 63 20 49 43 46 50 27 30 30 2c 20 . Proc ICFP'00,
14d0: 70 70 2e 20 31 38 36 2d 31 39 37 2e 0a 0a 3b 20 pp. 186-197...;
14e0: 49 4d 50 4f 52 54 0a 3b 20 70 61 72 73 65 72 2d IMPORT.; parser-
14f0: 65 72 72 6f 72 20 73 73 61 78 3a 77 61 72 6e 2c error ssax:warn,
1500: 20 73 65 65 20 48 61 6e 64 6c 69 6e 67 20 6f 66 see Handling of
1510: 20 65 72 72 6f 72 73 2c 20 62 65 6c 6f 77 0a 3b errors, below.;
1520: 20 66 75 6e 63 74 69 6f 6e 73 20 64 65 63 6c 61 functions decla
1530: 72 65 64 20 69 6e 20 66 69 6c 65 73 20 75 74 69 red in files uti
1540: 6c 2e 73 63 6d 2c 20 69 6e 70 75 74 2d 70 61 72 l.scm, input-par
1550: 73 65 2e 73 63 6d 20 61 6e 64 20 6c 6f 6f 6b 2d se.scm and look-
1560: 66 6f 72 2d 73 74 72 2e 73 63 6d 0a 3b 20 63 68 for-str.scm.; ch
1570: 61 72 2d 65 6e 63 6f 64 69 6e 67 2e 73 63 6d 20 ar-encoding.scm
1580: 66 6f 72 20 76 61 72 69 6f 75 73 20 70 6c 61 74 for various plat
1590: 66 6f 72 6d 2d 73 70 65 63 69 66 69 63 20 63 68 form-specific ch
15a0: 61 72 61 63 74 65 72 2d 65 6e 63 6f 64 69 6e 67 aracter-encoding
15b0: 20 66 75 6e 63 74 69 6f 6e 73 2e 0a 3b 20 46 72 functions..; Fr
15c0: 6f 6d 20 53 52 46 49 2d 31 33 3a 20 73 74 72 69 om SRFI-13: stri
15d0: 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 65 2f 73 ng-concatenate/s
15e0: 68 61 72 65 64 20 61 6e 64 20 73 74 72 69 6e 67 hared and string
15f0: 2d 63 6f 6e 63 61 74 65 6e 61 74 65 2d 72 65 76 -concatenate-rev
1600: 65 72 73 65 2f 73 68 61 72 65 64 0a 3b 20 49 66 erse/shared.; If
1610: 20 61 20 70 61 72 74 69 63 75 6c 61 72 20 69 6d a particular im
1620: 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 6c 61 63 plementation lac
1630: 6b 73 20 53 52 46 49 2d 31 33 20 73 75 70 70 6f ks SRFI-13 suppo
1640: 72 74 2c 20 70 6c 65 61 73 65 0a 3b 20 69 6e 63 rt, please.; inc
1650: 6c 75 64 65 20 74 68 65 20 66 69 6c 65 20 73 72 lude the file sr
1660: 66 69 2d 31 33 2d 6c 6f 63 61 6c 2e 73 63 6d 0a fi-13-local.scm.
1670: 0a 3b 20 48 61 6e 64 6c 69 6e 67 20 6f 66 20 65 .; Handling of e
1680: 72 72 6f 72 73 0a 3b 20 54 68 69 73 20 70 61 63 rrors.; This pac
1690: 6b 61 67 65 20 72 65 6c 69 65 73 20 6f 6e 20 61 kage relies on a
16a0: 20 66 75 6e 63 74 69 6f 6e 20 70 61 72 73 65 72 function parser
16b0: 2d 65 72 72 6f 72 2c 20 77 68 69 63 68 20 6d 75 -error, which mu
16c0: 73 74 20 62 65 20 64 65 66 69 6e 65 64 0a 3b 20 st be defined.;
16d0: 62 79 20 61 20 75 73 65 72 20 6f 66 20 74 68 65 by a user of the
16e0: 20 70 61 63 6b 61 67 65 2e 20 54 68 65 20 66 75 package. The fu
16f0: 6e 63 74 69 6f 6e 20 68 61 73 20 74 68 65 20 66 nction has the f
1700: 6f 6c 6c 6f 77 69 6e 67 20 73 69 67 6e 61 74 75 ollowing signatu
1710: 72 65 3a 0a 3b 09 70 61 72 73 65 72 2d 65 72 72 re:.;.parser-err
1720: 6f 72 20 50 4f 52 54 20 4d 45 53 53 41 47 45 20 or PORT MESSAGE
1730: 53 50 45 43 49 41 4c 49 53 49 4e 47 2d 4d 53 47 SPECIALISING-MSG
1740: 2a 0a 3b 20 4d 61 6e 79 20 70 72 6f 63 65 64 75 *.; Many procedu
1750: 72 65 73 20 6f 66 20 74 68 69 73 20 70 61 63 6b res of this pack
1760: 61 67 65 20 63 61 6c 6c 20 27 70 61 72 73 65 72 age call 'parser
1770: 2d 65 72 72 6f 72 27 20 77 68 65 6e 65 76 65 72 -error' whenever
1780: 20 61 0a 3b 20 70 61 72 73 69 6e 67 2c 20 77 65 a.; parsing, we
1790: 6c 6c 2d 66 6f 72 6d 65 64 6e 65 73 73 20 6f 72 ll-formedness or
17a0: 20 76 61 6c 69 64 61 74 69 6f 6e 20 65 72 72 6f validation erro
17b0: 72 20 69 73 20 65 6e 63 6f 75 6e 74 65 72 65 64 r is encountered
17c0: 2e 20 54 68 65 0a 3b 20 66 69 72 73 74 20 61 72 . The.; first ar
17d0: 67 75 6d 65 6e 74 20 69 73 20 61 20 70 6f 72 74 gument is a port
17e0: 2c 20 77 68 69 63 68 20 74 79 70 69 63 61 6c 6c , which typicall
17f0: 79 20 70 6f 69 6e 74 73 20 74 6f 20 74 68 65 20 y points to the
1800: 6f 66 66 65 6e 64 69 6e 67 0a 3b 20 63 68 61 72 offending.; char
1810: 61 63 74 65 72 20 6f 72 20 69 74 73 20 6e 65 69 acter or its nei
1820: 67 68 62 6f 72 68 6f 6f 64 2e 20 4d 6f 73 74 20 ghborhood. Most
1830: 6f 66 20 74 68 65 20 53 63 68 65 6d 65 20 73 79 of the Scheme sy
1840: 73 74 65 6d 73 20 6c 65 74 20 74 68 65 0a 3b 20 stems let the.;
1850: 75 73 65 72 20 71 75 65 72 79 20 61 20 50 4f 52 user query a POR
1860: 54 20 66 6f 72 20 74 68 65 20 63 75 72 72 65 6e T for the curren
1870: 74 20 70 6f 73 69 74 69 6f 6e 2e 20 54 68 65 20 t position. The
1880: 4d 45 53 53 41 47 45 20 61 72 67 75 6d 65 6e 74 MESSAGE argument
1890: 0a 3b 20 69 6e 64 69 63 61 74 65 73 20 61 20 66 .; indicates a f
18a0: 61 69 6c 65 64 20 58 4d 4c 20 70 72 6f 64 75 63 ailed XML produc
18b0: 74 69 6f 6e 20 6f 72 20 61 20 66 61 69 6c 65 64 tion or a failed
18c0: 20 58 4d 4c 20 63 6f 6e 73 74 72 61 69 6e 74 2e XML constraint.
18d0: 20 54 68 65 0a 3b 20 6c 61 74 74 65 72 20 69 73 The.; latter is
18e0: 20 72 65 66 65 72 72 65 64 20 74 6f 20 62 79 20 referred to by
18f0: 69 74 73 20 61 6e 63 68 6f 72 20 6e 61 6d 65 20 its anchor name
1900: 69 6e 20 74 68 65 20 58 4d 4c 20 52 65 63 6f 6d in the XML Recom
1910: 6d 65 6e 64 61 74 69 6f 6e 0a 3b 20 6f 72 20 58 mendation.; or X
1920: 4d 4c 20 4e 61 6d 65 73 70 61 63 65 73 20 52 65 ML Namespaces Re
1930: 63 6f 6d 6d 65 6e 64 61 74 69 6f 6e 2e 20 54 68 commendation. Th
1940: 65 20 70 61 72 73 69 6e 67 20 6c 69 62 72 61 72 e parsing librar
1950: 79 20 28 65 2e 67 2e 2c 0a 3b 20 6e 65 78 74 2d y (e.g.,.; next-
1960: 74 6f 6b 65 6e 2c 20 61 73 73 65 72 74 2d 63 75 token, assert-cu
1970: 72 72 2d 63 68 61 72 29 20 69 6e 76 6f 6b 65 20 rr-char) invoke
1980: 27 70 61 72 73 65 72 2d 65 72 72 6f 72 27 20 61 'parser-error' a
1990: 73 20 77 65 6c 6c 2c 20 69 6e 0a 3b 20 65 78 61 s well, in.; exa
19a0: 63 74 6c 79 20 74 68 65 20 73 61 6d 65 20 77 61 ctly the same wa
19b0: 79 2e 20 20 53 65 65 20 69 6e 70 75 74 2d 70 61 y. See input-pa
19c0: 72 73 65 2e 73 63 6d 20 66 6f 72 20 6d 6f 72 65 rse.scm for more
19d0: 20 64 65 74 61 69 6c 73 2e 0a 3b 20 53 65 65 0a details..; See.
19e0: 3b 09 68 74 74 70 3a 2f 2f 70 61 69 72 2e 63 6f ;.http://pair.co
19f0: 6d 2f 6c 69 73 6f 76 73 6b 79 2f 64 6f 77 6e 6c m/lisovsky/downl
1a00: 6f 61 64 2f 70 61 72 73 65 2d 65 72 72 6f 72 2e oad/parse-error.
1a10: 73 63 6d 0a 3b 20 66 6f 72 20 61 6e 20 65 78 63 scm.; for an exc
1a20: 65 6c 6c 65 6e 74 20 65 78 61 6d 70 6c 65 20 6f ellent example o
1a30: 66 20 73 75 63 68 20 61 20 72 65 64 65 66 69 6e f such a redefin
1a40: 65 64 20 70 61 72 73 65 72 2d 65 72 72 6f 72 20 ed parser-error
1a50: 66 75 6e 63 74 69 6f 6e 2e 0a 3b 0a 3b 20 49 6e function..;.; In
1a60: 20 61 64 64 69 74 69 6f 6e 2c 20 74 68 65 20 70 addition, the p
1a70: 72 65 73 65 6e 74 20 63 6f 64 65 20 69 6e 76 6f resent code invo
1a80: 6b 65 73 20 61 20 66 75 6e 63 74 69 6f 6e 20 73 kes a function s
1a90: 73 61 78 3a 77 61 72 6e 0a 3b 20 20 20 73 73 61 sax:warn.; ssa
1aa0: 78 3a 77 61 72 6e 20 50 4f 52 54 20 4d 45 53 53 x:warn PORT MESS
1ab0: 41 47 45 20 53 50 45 43 49 41 4c 49 53 49 4e 47 AGE SPECIALISING
1ac0: 2d 4d 53 47 2a 0a 3b 20 74 6f 20 6e 6f 74 69 66 -MSG*.; to notif
1ad0: 79 20 74 68 65 20 75 73 65 72 20 61 62 6f 75 74 y the user about
1ae0: 20 77 61 72 6e 69 6e 67 73 20 74 68 61 74 20 61 warnings that a
1af0: 72 65 20 4e 4f 54 20 65 72 72 6f 72 73 20 62 75 re NOT errors bu
1b00: 74 20 73 74 69 6c 6c 0a 3b 20 6d 61 79 20 61 6c t still.; may al
1b10: 65 72 74 20 74 68 65 20 75 73 65 72 2e 0a 3b 0a ert the user..;.
1b20: 3b 20 41 67 61 69 6e 2c 20 70 61 72 73 65 72 2d ; Again, parser-
1b30: 65 72 72 6f 72 20 61 6e 64 20 73 73 61 78 3a 77 error and ssax:w
1b40: 61 72 6e 20 61 72 65 20 73 75 70 70 6f 73 65 64 arn are supposed
1b50: 20 74 6f 20 62 65 20 64 65 66 69 6e 65 64 20 62 to be defined b
1b60: 79 20 74 68 65 0a 3b 20 75 73 65 72 2e 20 48 6f y the.; user. Ho
1b70: 77 65 76 65 72 2c 20 69 66 20 61 20 72 75 6e 2d wever, if a run-
1b80: 74 65 73 74 20 6d 61 63 72 6f 20 62 65 6c 6f 77 test macro below
1b90: 20 69 73 20 73 65 74 20 74 6f 20 69 6e 63 6c 75 is set to inclu
1ba0: 64 65 0a 3b 20 73 65 6c 66 2d 74 65 73 74 73 2c de.; self-tests,
1bb0: 20 74 68 69 73 20 70 72 65 73 65 6e 74 20 63 6f this present co
1bc0: 64 65 20 64 6f 65 73 20 70 72 6f 76 69 64 65 20 de does provide
1bd0: 74 68 65 20 64 65 66 69 6e 69 74 69 6f 6e 73 20 the definitions
1be0: 66 6f 72 20 74 68 65 73 65 0a 3b 20 66 75 6e 63 for these.; func
1bf0: 74 69 6f 6e 73 20 74 6f 20 61 6c 6c 6f 77 20 74 tions to allow t
1c00: 65 73 74 73 20 74 6f 20 72 75 6e 2e 0a 0a 3b 20 ests to run...;
1c10: 4d 69 73 63 20 6e 6f 74 65 73 0a 3b 20 49 74 20 Misc notes.; It
1c20: 73 65 65 6d 73 20 69 74 20 69 73 20 68 69 67 68 seems it is high
1c30: 6c 79 20 64 65 73 69 72 61 62 6c 65 20 74 6f 20 ly desirable to
1c40: 73 65 70 61 72 61 74 65 20 74 65 73 74 73 20 6f separate tests o
1c50: 75 74 20 69 6e 20 61 20 64 65 64 69 63 61 74 65 ut in a dedicate
1c60: 64 0a 3b 20 66 69 6c 65 2e 0a 3b 0a 3b 20 4a 69 d.; file..;.; Ji
1c70: 6d 20 42 65 6e 64 65 72 20 77 72 6f 74 65 20 6f m Bender wrote o
1c80: 6e 20 4d 6f 6e 2c 20 39 20 53 65 70 20 32 30 30 n Mon, 9 Sep 200
1c90: 32 20 32 30 3a 30 33 3a 34 32 20 45 44 54 20 6f 2 20:03:42 EDT o
1ca0: 6e 20 74 68 65 20 53 53 41 58 2d 53 58 4d 4c 0a n the SSAX-SXML.
1cb0: 3b 20 6d 61 69 6c 69 6e 67 20 6c 69 73 74 20 28 ; mailing list (
1cc0: 6d 65 73 73 61 67 65 20 41 20 66 69 6e 65 2d 67 message A fine-g
1cd0: 72 61 69 6e 65 64 20 22 6c 65 67 6f 22 29 0a 3b rained "lego").;
1ce0: 20 54 68 65 20 74 61 73 6b 20 77 61 73 20 74 6f The task was to
1cf0: 20 72 65 63 6f 72 64 20 70 72 65 63 69 73 65 20 record precise
1d00: 73 6f 75 72 63 65 20 6c 6f 63 61 74 69 6f 6e 20 source location
1d10: 69 6e 66 6f 72 6d 61 74 69 6f 6e 2c 20 61 73 20 information, as
1d20: 50 4c 54 0a 3b 20 64 6f 65 73 20 77 69 74 68 20 PLT.; does with
1d30: 69 74 73 20 63 75 72 72 65 6e 74 20 58 4d 4c 20 its current XML
1d40: 70 61 72 73 65 72 2e 20 54 68 61 74 20 70 61 72 parser. That par
1d50: 73 65 72 20 72 65 63 6f 72 64 73 20 74 68 65 20 ser records the
1d60: 73 74 61 72 74 20 61 6e 64 0a 3b 20 65 6e 64 20 start and.; end
1d70: 6c 6f 63 61 74 69 6f 6e 20 28 66 69 6c 65 70 6f location (filepo
1d80: 73 2c 20 6c 69 6e 65 23 2c 20 63 6f 6c 75 6d 6e s, line#, column
1d90: 23 29 20 66 6f 72 20 70 69 2c 20 65 6c 65 6d 65 #) for pi, eleme
1da0: 6e 74 73 2c 20 61 74 74 72 69 62 75 74 65 73 2c nts, attributes,
1db0: 0a 3b 20 63 68 75 6e 63 6b 73 20 6f 66 20 22 70 .; chuncks of "p
1dc0: 63 64 61 74 61 22 2e 0a 3b 20 41 73 20 73 75 67 cdata"..; As sug
1dd0: 67 65 73 74 65 64 20 61 62 6f 76 65 2c 20 74 68 gested above, th
1de0: 6f 75 67 68 2c 20 69 6e 20 73 6f 6d 65 20 63 61 ough, in some ca
1df0: 73 65 73 20 49 20 6e 65 65 64 65 64 20 74 6f 20 ses I needed to
1e00: 62 65 20 61 62 6c 65 20 66 6f 72 63 65 0a 3b 20 be able force.;
1e10: 6f 70 65 6e 20 61 6e 20 69 6e 74 65 72 66 61 63 open an interfac
1e20: 65 20 74 68 61 74 20 64 69 64 20 6e 6f 74 20 79 e that did not y
1e30: 65 74 20 65 78 69 73 74 2e 20 46 6f 72 20 69 6e et exist. For in
1e40: 73 74 61 6e 63 65 2c 20 49 20 61 64 64 65 64 20 stance, I added
1e50: 61 6e 0a 3b 20 22 65 6e 64 2d 63 68 61 72 2d 64 an.; "end-char-d
1e60: 61 74 61 2d 68 6f 6f 6b 22 2c 20 77 68 69 63 68 ata-hook", which
1e70: 20 77 6f 75 6c 64 20 62 65 20 63 61 6c 6c 65 64 would be called
1e80: 20 61 74 20 74 68 65 20 65 6e 64 20 6f 66 20 63 at the end of c
1e90: 68 61 72 2d 64 61 74 61 0a 3b 20 66 72 61 67 6d har-data.; fragm
1ea0: 65 6e 74 2e 20 54 68 69 73 20 72 65 74 75 72 6e ent. This return
1eb0: 73 20 61 20 66 75 6e 63 74 69 6f 6e 20 6f 66 20 s a function of
1ec0: 74 79 70 65 20 28 73 65 65 64 20 2d 3e 20 73 65 type (seed -> se
1ed0: 65 64 29 20 77 68 69 63 68 20 69 73 0a 3b 20 69 ed) which is.; i
1ee0: 6e 76 6f 6b 65 64 20 6f 6e 20 74 68 65 20 63 75 nvoked on the cu
1ef0: 72 72 65 6e 74 20 73 65 65 64 20 6f 6e 6c 79 20 rrent seed only
1f00: 69 66 20 72 65 61 64 2d 63 68 61 72 2d 64 61 74 if read-char-dat
1f10: 61 20 68 61 73 20 69 6e 64 65 65 64 20 72 65 61 a has indeed rea
1f20: 63 68 65 64 0a 3b 20 74 68 65 20 65 6e 64 20 6f ched.; the end o
1f30: 66 20 61 20 62 6c 6f 63 6b 20 6f 66 20 63 68 61 f a block of cha
1f40: 72 20 64 61 74 61 20 28 61 66 74 65 72 20 72 65 r data (after re
1f50: 61 64 69 6e 67 20 61 20 6e 65 77 20 74 6f 6b 65 ading a new toke
1f60: 6e 2e 0a 3b 20 42 75 74 20 74 68 65 20 64 65 65 n..; But the dee
1f70: 70 65 73 74 20 69 6e 74 65 72 66 61 63 65 20 74 pest interface t
1f80: 68 61 74 20 49 20 6e 65 65 64 65 64 20 74 6f 20 hat I needed to
1f90: 65 78 70 6f 73 65 20 77 61 73 20 74 68 61 74 20 expose was that
1fa0: 6f 66 20 72 65 61 64 69 6e 67 0a 3b 20 61 74 74 of reading.; att
1fb0: 72 69 62 75 74 65 73 2e 20 49 6e 20 74 68 65 20 ributes. In the
1fc0: 6f 66 66 69 63 69 61 6c 20 64 69 73 74 72 69 62 official distrib
1fd0: 75 74 69 6f 6e 2c 20 74 68 69 73 20 69 73 20 6e ution, this is n
1fe0: 6f 74 20 65 76 65 6e 20 61 20 73 65 70 61 72 61 ot even a separa
1ff0: 74 65 0a 3b 20 66 75 6e 63 74 69 6f 6e 2e 20 49 te.; function. I
2000: 6e 73 74 65 61 64 2c 20 69 74 20 69 73 20 65 6d nstead, it is em
2010: 62 65 64 64 65 64 20 77 69 74 68 69 6e 20 53 53 bedded within SS
2020: 41 58 3a 72 65 61 64 2d 61 74 74 72 69 62 75 74 AX:read-attribut
2030: 65 73 2e 20 20 54 68 69 73 0a 3b 20 72 65 71 75 es. This.; requ
2040: 69 72 65 64 20 73 6f 6d 65 20 73 6d 61 6c 6c 20 ired some small
2050: 72 65 2d 73 74 72 75 63 74 75 72 69 6e 67 20 61 re-structuring a
2060: 73 20 77 65 6c 6c 2e 0a 3b 20 54 68 69 73 20 64 s well..; This d
2070: 65 66 69 6e 69 74 65 6c 79 20 77 69 6c 6c 20 6e efinitely will n
2080: 6f 74 20 62 65 20 74 6f 20 65 76 65 72 79 6f 6e ot be to everyon
2090: 65 27 73 20 74 61 73 74 65 20 28 6e 6f 72 20 6e e's taste (nor n
20a0: 65 65 64 65 64 20 62 79 20 6d 6f 73 74 29 2e 0a eeded by most)..
20b0: 3b 20 43 65 72 74 61 69 6e 6c 79 2c 20 74 68 65 ; Certainly, the
20c0: 20 65 78 69 73 74 69 6e 67 20 6d 61 6b 65 2d 70 existing make-p
20d0: 61 72 73 65 72 20 69 6e 74 65 72 66 61 63 65 20 arser interface
20e0: 61 64 64 72 65 73 73 65 73 20 6d 6f 73 74 20 63 addresses most c
20f0: 75 73 74 6f 6d 0a 3b 20 6e 65 65 64 73 2e 20 41 ustom.; needs. A
2100: 6e 64 20 6c 69 6b 65 6c 79 20 38 30 2d 39 30 20 nd likely 80-90
2110: 6c 69 6e 65 73 20 6f 66 20 61 20 22 6c 69 6e 6b lines of a "link
2120: 20 73 70 65 63 69 66 69 63 61 74 69 6f 6e 22 20 specification"
2130: 74 6f 20 63 72 65 61 74 65 20 61 0a 3b 20 70 61 to create a.; pa
2140: 72 73 65 72 20 66 72 6f 6d 20 6d 61 6e 79 20 74 rser from many t
2150: 69 6e 79 20 6c 69 74 74 6c 65 20 6c 65 67 6f 20 iny little lego
2160: 62 6c 6f 63 6b 73 20 6d 61 79 20 70 6c 65 61 73 blocks may pleas
2170: 65 20 6f 6e 6c 79 20 61 20 66 65 77 2c 20 77 68 e only a few, wh
2180: 69 6c 65 0a 3b 20 61 70 70 61 6c 6c 69 6e 67 20 ile.; appalling
2190: 6f 74 68 65 72 73 2e 0a 3b 20 54 68 65 20 63 6f others..; The co
21a0: 64 65 20 69 73 20 61 76 61 69 6c 61 62 6c 65 20 de is available
21b0: 61 74 20 68 74 74 70 3a 2f 2f 63 65 6c 74 69 63 at http://celtic
21c0: 2e 62 65 6e 64 65 72 77 65 62 2e 6e 65 74 2f 73 .benderweb.net/s
21d0: 73 61 78 2d 6c 65 67 6f 2e 70 6c 74 20 6f 72 20 sax-lego.plt or
21e0: 0a 3b 20 68 74 74 70 3a 2f 2f 63 65 6c 74 69 63 .; http://celtic
21f0: 2e 62 65 6e 64 65 72 77 65 62 2e 6e 65 74 2f 73 .benderweb.net/s
2200: 73 61 78 2d 6c 65 67 6f 2e 74 61 72 2e 67 7a 0a sax-lego.tar.gz.
2210: 3b 20 49 6e 20 74 68 65 20 65 78 61 6d 70 6c 65 ; In the example
2220: 73 20 64 69 72 65 63 74 6f 72 79 2c 20 49 20 70 s directory, I p
2230: 72 6f 76 69 64 65 3a 0a 3b 20 2d 20 61 20 75 6e rovide:.; - a un
2240: 69 74 20 76 65 72 73 69 6f 6e 20 6f 66 20 74 68 it version of th
2250: 65 20 6d 61 6b 65 2d 70 61 72 73 65 72 20 69 6e e make-parser in
2260: 74 65 72 66 61 63 65 2c 0a 3b 20 2d 20 61 20 73 terface,.; - a s
2270: 69 6d 70 6c 65 20 53 58 4d 4c 20 70 61 72 73 65 imple SXML parse
2280: 72 20 75 73 69 6e 67 20 74 68 61 74 20 69 6e 74 r using that int
2290: 65 72 66 61 63 65 2c 20 0a 3b 20 2d 20 61 6e 20 erface, .; - an
22a0: 53 58 4d 4c 20 70 61 72 73 65 72 20 77 68 69 63 SXML parser whic
22b0: 68 20 64 69 72 65 63 74 6c 79 20 75 73 65 73 20 h directly uses
22c0: 74 68 65 20 22 6e 65 77 20 6c 65 67 6f 22 2c 0a the "new lego",.
22d0: 3b 20 2d 20 61 20 70 73 65 75 64 6f 2d 53 58 4d ; - a pseudo-SXM
22e0: 4c 20 70 61 72 73 65 72 2c 20 77 68 69 63 68 20 L parser, which
22f0: 72 65 63 6f 72 64 73 20 73 6f 75 72 63 65 20 6c records source l
2300: 6f 63 61 74 69 6f 6e 20 69 6e 66 6f 72 6d 61 74 ocation informat
2310: 69 6f 6e 0a 3b 20 2d 20 61 6e 64 20 6c 61 73 74 ion.; - and last
2320: 6c 79 20 61 20 70 61 72 73 65 72 20 77 68 69 63 ly a parser whic
2330: 68 20 72 65 74 75 72 6e 73 20 74 68 65 20 73 74 h returns the st
2340: 72 75 63 74 75 72 65 73 20 75 73 65 64 20 69 6e ructures used in
2350: 20 50 4c 54 27 73 20 78 6d 6c 20 0a 3b 20 63 6f PLT's xml .; co
2360: 6c 6c 65 63 74 69 6f 6e 2c 20 77 69 74 68 20 73 llection, with s
2370: 6f 75 72 63 65 20 6c 6f 63 61 74 69 6f 6e 20 69 ource location i
2380: 6e 66 6f 72 6d 61 74 69 6f 6e 0a 0a 3b 20 24 49 nformation..; $I
2390: 64 3a 20 53 53 41 58 2e 73 63 6d 2c 76 20 35 2e d: SSAX.scm,v 5.
23a0: 31 20 32 30 30 34 2f 30 37 2f 30 37 20 31 36 3a 1 2004/07/07 16:
23b0: 30 32 3a 33 30 20 73 70 65 72 62 65 72 20 45 78 02:30 sperber Ex
23c0: 70 20 24 0a 3b 5e 5e 5e 5e 5e 5e 5e 5e 5e 0a 0a p $.;^^^^^^^^^..
23d0: 0a 09 3b 20 53 65 65 20 74 68 65 20 4d 61 6b 65 ..; See the Make
23e0: 66 69 6c 65 20 69 6e 20 74 68 65 20 2e 2e 2f 74 file in the ../t
23f0: 65 73 74 73 20 64 69 72 65 63 74 6f 72 79 0a 09 ests directory..
2400: 3b 20 28 69 6e 20 70 61 72 74 69 63 75 6c 61 72 ; (in particular
2410: 2c 20 74 68 65 20 72 75 6c 65 20 76 53 53 41 58 , the rule vSSAX
2420: 29 20 66 6f 72 20 61 6e 20 65 78 61 6d 70 6c 65 ) for an example
2430: 20 6f 66 20 68 6f 77 0a 09 3b 20 74 6f 20 72 75 of how..; to ru
2440: 6e 20 74 68 69 73 20 63 6f 64 65 20 6f 6e 20 76 n this code on v
2450: 61 72 69 6f 75 73 20 53 63 68 65 6d 65 20 73 79 arious Scheme sy
2460: 73 74 65 6d 73 2e 0a 09 3b 20 53 65 65 20 53 53 stems...; See SS
2470: 41 58 20 65 78 61 6d 70 6c 65 73 20 66 6f 72 20 AX examples for
2480: 6d 61 6e 79 20 73 61 6d 70 6c 65 73 20 6f 66 20 many samples of
2490: 75 73 69 6e 67 20 74 68 69 73 20 63 6f 64 65 2c using this code,
24a0: 0a 09 3b 20 61 67 61 69 6e 2c 20 6f 6e 20 61 20 ..; again, on a
24b0: 76 61 72 69 65 74 79 20 6f 66 20 53 63 68 65 6d variety of Schem
24c0: 65 20 73 79 73 74 65 6d 73 2e 0a 09 3b 20 53 65 e systems...; Se
24d0: 65 20 68 74 74 70 3a 2f 2f 73 73 61 78 2e 73 66 e http://ssax.sf
24e0: 2e 6e 65 74 2f 0a 0a 0a 3b 20 54 68 65 20 66 6f .net/...; The fo
24f0: 6c 6c 6f 77 69 6e 67 20 6d 61 63 72 6f 20 72 75 llowing macro ru
2500: 6e 73 20 62 75 69 6c 74 2d 69 6e 20 74 65 73 74 ns built-in test
2510: 20 63 61 73 65 73 20 2d 2d 20 6f 72 20 64 6f 65 cases -- or doe
2520: 73 20 6e 6f 74 20 72 75 6e 2c 0a 3b 20 64 65 70 s not run,.; dep
2530: 65 6e 64 69 6e 67 20 6f 6e 20 77 68 69 63 68 20 ending on which
2540: 6f 66 20 74 68 65 20 74 77 6f 20 63 61 73 65 73 of the two cases
2550: 20 62 65 6c 6f 77 20 79 6f 75 20 63 6f 6d 6d 65 below you comme
2560: 6e 74 65 64 20 6f 75 74 0a 3b 20 43 61 73 65 20 nted out.; Case
2570: 31 3a 20 6e 6f 20 74 65 73 74 73 3a 0a 3b 28 64 1: no tests:.;(d
2580: 65 66 69 6e 65 2d 6d 61 63 72 6f 20 72 75 6e 2d efine-macro run-
2590: 74 65 73 74 20 28 6c 61 6d 62 64 61 20 62 6f 64 test (lambda bod
25a0: 79 20 27 28 62 65 67 69 6e 20 23 66 29 29 29 0a y '(begin #f))).
25b0: 3b 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 ;(define-syntax
25c0: 72 75 6e 2d 74 65 73 74 20 28 73 79 6e 74 61 78 run-test (syntax
25d0: 2d 72 75 6c 65 73 20 28 29 20 28 28 72 75 6e 2d -rules () ((run-
25e0: 74 65 73 74 20 2e 20 61 72 67 73 29 20 28 62 65 test . args) (be
25f0: 67 69 6e 20 23 66 29 29 29 29 0a 0a 3b 20 43 61 gin #f))))..; Ca
2600: 73 65 20 32 3a 20 77 69 74 68 20 74 65 73 74 73 se 2: with tests
2610: 2e 0a 3b 20 54 68 65 20 66 6f 6c 6c 6f 77 69 6e ..; The followin
2620: 67 20 6d 61 63 72 6f 20 63 6f 75 6c 64 27 76 65 g macro could've
2630: 20 62 65 65 6e 20 64 65 66 69 6e 65 64 20 6a 75 been defined ju
2640: 73 74 20 61 73 0a 3b 20 28 64 65 66 69 6e 65 2d st as.; (define-
2650: 6d 61 63 72 6f 20 72 75 6e 2d 74 65 73 74 20 28 macro run-test (
2660: 6c 61 6d 62 64 61 20 62 6f 64 79 20 60 28 62 65 lambda body `(be
2670: 67 69 6e 20 28 64 69 73 70 6c 61 79 20 22 5c 6e gin (display "\n
2680: 2d 2d 3e 54 65 73 74 5c 6e 22 29 20 2c 40 62 6f -->Test\n") ,@bo
2690: 64 79 29 29 29 0a 3b 0a 3b 20 49 6e 73 74 65 61 dy))).;.; Instea
26a0: 64 2c 20 69 74 27 73 20 6d 6f 72 65 20 69 6e 76 d, it's more inv
26b0: 6f 6c 76 65 64 2c 20 74 6f 20 6d 61 6b 65 20 75 olved, to make u
26c0: 70 20 66 6f 72 20 63 61 73 65 2d 69 6e 73 65 6e p for case-insen
26d0: 73 69 74 69 76 69 74 79 20 6f 66 0a 3b 20 73 79 sitivity of.; sy
26e0: 6d 62 6f 6c 73 20 6f 6e 20 73 6f 6d 65 20 53 63 mbols on some Sc
26f0: 68 65 6d 65 20 73 79 73 74 65 6d 73 2e 20 49 6e heme systems. In
2700: 20 47 61 6d 62 69 74 2c 20 73 79 6d 62 6f 6c 73 Gambit, symbols
2710: 20 61 72 65 20 63 61 73 65 0a 3b 20 73 65 6e 73 are case.; sens
2720: 69 74 69 76 65 3a 20 28 65 71 3f 20 27 41 20 27 itive: (eq? 'A '
2730: 61 29 20 69 73 20 23 66 20 61 6e 64 20 28 65 71 a) is #f and (eq
2740: 3f 20 27 41 61 20 28 73 74 72 69 6e 67 2d 3e 73 ? 'Aa (string->s
2750: 79 6d 62 6f 6c 20 22 41 61 22 29 29 20 69 73 0a ymbol "Aa")) is.
2760: 3b 20 23 74 2e 20 20 4f 6e 20 73 6f 6d 65 20 73 ; #t. On some s
2770: 79 73 74 65 6d 73 2c 20 73 79 6d 62 6f 6c 73 20 ystems, symbols
2780: 61 72 65 20 63 61 73 65 2d 69 6e 73 65 6e 73 69 are case-insensi
2790: 74 69 76 65 20 61 6e 64 20 6a 75 73 74 20 74 68 tive and just th
27a0: 65 0a 3b 20 6f 70 70 6f 73 69 74 65 20 69 73 20 e.; opposite is
27b0: 74 72 75 65 2e 20 20 54 68 65 72 65 66 6f 72 65 true. Therefore
27c0: 2c 20 77 65 20 69 6e 74 72 6f 64 75 63 65 20 61 , we introduce a
27d0: 20 6e 6f 74 61 74 69 6f 6e 20 27 22 41 53 79 6d notation '"ASym
27e0: 62 6f 6c 22 20 28 61 0a 3b 20 71 75 6f 74 65 64 bol" (a.; quoted
27f0: 20 73 74 72 69 6e 67 29 20 74 68 61 74 20 73 74 string) that st
2800: 61 6e 64 73 20 66 6f 72 20 61 20 63 61 73 65 2d ands for a case-
2810: 5f 73 65 6e 73 69 74 69 76 65 5f 20 41 53 79 6d _sensitive_ ASym
2820: 62 6f 6c 20 2d 2d 20 6f 6e 20 61 6e 79 0a 3b 20 bol -- on any.;
2830: 52 35 52 53 20 53 63 68 65 6d 65 20 73 79 73 74 R5RS Scheme syst
2840: 65 6d 2e 20 54 68 69 73 20 6e 6f 74 61 74 69 6f em. This notatio
2850: 6e 20 69 73 20 76 61 6c 69 64 20 6f 6e 6c 79 20 n is valid only
2860: 77 69 74 68 69 6e 20 74 68 65 20 62 6f 64 79 20 within the body
2870: 6f 66 0a 3b 20 72 75 6e 2d 74 65 73 74 2e 0a 3b of.; run-test..;
2880: 20 54 68 65 20 6e 6f 74 61 74 69 6f 6e 20 69 73 The notation is
2890: 20 69 6d 70 6c 65 6d 65 6e 74 65 64 20 62 79 20 implemented by
28a0: 73 63 61 6e 6e 69 6e 67 20 74 68 65 20 72 75 6e scanning the run
28b0: 2d 74 65 73 74 27 73 0a 3b 20 62 6f 64 79 20 61 -test's.; body a
28c0: 6e 64 20 72 65 70 6c 61 63 69 6e 67 20 65 76 65 nd replacing eve
28d0: 72 79 20 6f 63 63 75 72 72 65 6e 63 65 20 6f 66 ry occurrence of
28e0: 20 28 71 75 6f 74 65 20 22 73 74 72 22 29 20 77 (quote "str") w
28f0: 69 74 68 20 74 68 65 20 72 65 73 75 6c 74 0a 3b ith the result.;
2900: 20 6f 66 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d of (string->sym
2910: 62 6f 6c 20 22 73 74 72 22 29 2e 20 57 65 20 63 bol "str"). We c
2920: 61 6e 20 64 6f 20 73 75 63 68 20 61 20 72 65 70 an do such a rep
2930: 6c 61 63 65 6d 65 6e 74 20 61 74 20 6d 61 63 72 lacement at macr
2940: 6f 2d 65 78 70 61 6e 64 0a 3b 20 74 69 6d 65 20 o-expand.; time
2950: 28 72 61 74 68 65 72 20 74 68 61 6e 20 61 74 20 (rather than at
2960: 72 75 6e 20 74 69 6d 65 29 2e 0a 0a 3b 20 48 65 run time)...; He
2970: 72 65 27 73 20 74 68 65 20 70 72 65 76 69 6f 75 re's the previou
2980: 73 20 76 65 72 73 69 6f 6e 20 6f 66 20 72 75 6e s version of run
2990: 2d 74 65 73 74 2c 20 69 6d 70 6c 65 6d 65 6e 74 -test, implement
29a0: 65 64 20 61 73 20 61 20 6c 6f 77 2d 6c 65 76 65 ed as a low-leve
29b0: 6c 0a 3b 20 6d 61 63 72 6f 2e 20 0a 3b 20 28 64 l.; macro. .; (d
29c0: 65 66 69 6e 65 2d 6d 61 63 72 6f 20 72 75 6e 2d efine-macro run-
29d0: 74 65 73 74 0a 3b 20 20 20 28 6c 61 6d 62 64 61 test.; (lambda
29e0: 20 62 6f 64 79 0a 3b 20 20 20 20 20 28 64 65 66 body.; (def
29f0: 69 6e 65 20 28 72 65 2d 77 72 69 74 65 20 62 6f ine (re-write bo
2a00: 64 79 29 0a 3b 20 20 20 20 20 20 20 28 63 6f 6e dy).; (con
2a10: 64 0a 3b 20 20 20 20 20 20 20 20 28 28 76 65 63 d.; ((vec
2a20: 74 6f 72 3f 20 62 6f 64 79 29 0a 3b 20 09 28 6c tor? body).; .(l
2a30: 69 73 74 2d 3e 76 65 63 74 6f 72 20 28 72 65 2d ist->vector (re-
2a40: 77 72 69 74 65 20 28 76 65 63 74 6f 72 2d 3e 6c write (vector->l
2a50: 69 73 74 20 62 6f 64 79 29 29 29 29 0a 3b 20 20 ist body)))).;
2a60: 20 20 20 20 20 20 28 28 6e 6f 74 20 28 70 61 69 ((not (pai
2a70: 72 3f 20 62 6f 64 79 29 29 20 62 6f 64 79 29 0a r? body)) body).
2a80: 3b 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 ; ((and (
2a90: 65 71 3f 20 27 71 75 6f 74 65 20 28 63 61 72 20 eq? 'quote (car
2aa0: 62 6f 64 79 29 29 20 28 70 61 69 72 3f 20 28 63 body)) (pair? (c
2ab0: 64 72 20 62 6f 64 79 29 29 0a 3b 20 09 20 20 20 dr body)).; .
2ac0: 20 20 28 73 74 72 69 6e 67 3f 20 28 63 61 64 72 (string? (cadr
2ad0: 20 62 6f 64 79 29 29 29 0a 3b 20 09 28 73 74 72 body))).; .(str
2ae0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 63 61 64 ing->symbol (cad
2af0: 72 20 62 6f 64 79 29 29 29 0a 3b 20 20 20 20 20 r body))).;
2b00: 20 20 20 28 65 6c 73 65 20 28 63 6f 6e 73 20 28 (else (cons (
2b10: 72 65 2d 77 72 69 74 65 20 28 63 61 72 20 62 6f re-write (car bo
2b20: 64 79 29 29 20 28 72 65 2d 77 72 69 74 65 20 28 dy)) (re-write (
2b30: 63 64 72 20 62 6f 64 79 29 29 29 29 29 29 0a 3b cdr body)))))).;
2b40: 20 20 20 20 20 28 63 6f 6e 73 20 27 62 65 67 69 (cons 'begi
2b50: 6e 20 28 72 65 2d 77 72 69 74 65 20 62 6f 64 79 n (re-write body
2b60: 29 29 29 29 0a 3b 0a 3b 20 46 6f 72 20 70 6f 72 )))).;.; For por
2b70: 74 61 62 69 6c 69 74 79 2c 20 69 74 20 69 73 20 tability, it is
2b80: 72 65 2d 77 72 69 74 74 65 6e 20 61 73 20 73 79 re-written as sy
2b90: 6e 74 61 78 2d 72 75 6c 65 73 2e 20 54 68 65 20 ntax-rules. The
2ba0: 73 79 6e 74 61 78 2d 72 75 6c 65 73 0a 3b 20 76 syntax-rules.; v
2bb0: 65 72 73 69 6f 6e 20 69 73 20 6c 65 73 73 20 70 ersion is less p
2bc0: 6f 77 65 72 66 75 6c 3a 20 66 6f 72 20 65 78 61 owerful: for exa
2bd0: 6d 70 6c 65 2c 20 69 74 20 63 61 6e 27 74 20 68 mple, it can't h
2be0: 61 6e 64 6c 65 0a 3b 20 28 63 61 73 65 20 78 20 andle.; (case x
2bf0: 28 28 27 22 46 6f 6f 22 29 20 28 64 6f 2d 6f 6e (('"Foo") (do-on
2c00: 2d 46 6f 6f 29 29 29 20 77 68 65 72 65 61 73 20 -Foo))) whereas
2c10: 74 68 65 20 6c 6f 77 2d 6c 65 76 65 6c 20 6d 61 the low-level ma
2c20: 63 72 6f 0a 3b 20 63 6f 75 6c 64 20 63 6f 72 72 cro.; could corr
2c30: 65 63 74 6c 79 20 70 6c 61 63 65 20 61 20 63 61 ectly place a ca
2c40: 73 65 2d 73 65 6e 73 69 74 69 76 65 20 73 79 6d se-sensitive sym
2c50: 62 6f 6c 20 61 74 20 74 68 65 20 72 69 67 68 74 bol at the right
2c60: 20 70 6c 61 63 65 2e 0a 3b 20 57 65 20 61 6c 73 place..; We als
2c70: 6f 20 64 6f 20 6e 6f 74 20 73 63 61 6e 20 76 65 o do not scan ve
2c80: 63 74 6f 72 73 20 28 62 65 63 61 75 73 65 20 77 ctors (because w
2c90: 65 20 64 6f 6e 27 74 20 75 73 65 20 74 68 65 6d e don't use them
2ca0: 20 68 65 72 65 29 2e 0a 3b 20 54 77 69 63 65 2d here)..; Twice-
2cb0: 64 65 65 70 20 71 75 61 73 69 71 75 6f 74 65 73 deep quasiquotes
2cc0: 20 61 72 65 6e 27 74 20 68 61 6e 64 6c 65 64 20 aren't handled
2cd0: 65 69 74 68 65 72 2e 0a 3b 20 53 74 69 6c 6c 2c either..; Still,
2ce0: 20 74 68 65 20 73 79 6e 74 61 78 2d 72 75 6c 65 the syntax-rule
2cf0: 73 20 76 65 72 73 69 6f 6e 20 73 61 74 69 73 66 s version satisf
2d00: 69 65 73 20 6f 75 72 20 69 6d 6d 65 64 69 61 74 ies our immediat
2d10: 65 20 6e 65 65 64 73 2e 0a 3b 20 49 6e 63 69 64 e needs..; Incid
2d20: 65 6e 74 61 6c 6c 79 2c 20 49 20 6f 72 69 67 69 entally, I origi
2d30: 6e 61 6c 6c 79 20 64 69 64 6e 27 74 20 62 65 6c nally didn't bel
2d40: 69 65 76 65 20 74 68 61 74 20 74 68 65 20 6d 61 ieve that the ma
2d50: 63 72 6f 20 62 65 6c 6f 77 0a 3b 20 77 61 73 20 cro below.; was
2d60: 61 74 20 61 6c 6c 20 70 6f 73 73 69 62 6c 65 2e at all possible.
2d70: 0a 3b 20 0a 3b 20 54 68 65 20 6d 61 63 72 6f 20 .; .; The macro
2d80: 69 73 20 77 72 69 74 74 65 6e 20 69 6e 20 61 20 is written in a
2d90: 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 2d 70 61 73 continuation-pas
2da0: 73 69 6e 67 20 73 74 79 6c 65 2e 20 41 20 63 6f sing style. A co
2db0: 6e 74 69 6e 75 61 74 69 6f 6e 0a 3b 20 74 79 70 ntinuation.; typ
2dc0: 69 63 61 6c 6c 79 20 68 61 73 20 74 68 65 20 66 ically has the f
2dd0: 6f 6c 6c 6f 77 69 6e 67 20 73 74 72 75 63 74 75 ollowing structu
2de0: 72 65 3a 20 28 6b 2d 68 65 61 64 20 21 20 2e 20 re: (k-head ! .
2df0: 61 72 67 73 29 0a 3b 20 57 68 65 6e 20 74 68 65 args).; When the
2e00: 20 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 20 69 73 continuation is
2e10: 20 69 6e 76 6f 6b 65 64 2c 20 77 65 20 65 78 70 invoked, we exp
2e20: 61 6e 64 20 69 6e 74 6f 0a 3b 20 28 6b 2d 68 65 and into.; (k-he
2e30: 61 64 20 3c 63 6f 6d 70 75 74 65 64 2d 72 65 73 ad <computed-res
2e40: 75 6c 74 3e 20 2e 20 61 72 67 29 2e 20 54 68 61 ult> . arg). Tha
2e50: 74 20 69 73 2c 20 74 68 65 20 64 65 64 69 63 61 t is, the dedica
2e60: 74 65 64 20 73 79 6d 62 6f 6c 20 21 0a 3b 20 69 ted symbol !.; i
2e70: 73 20 74 68 65 20 70 6c 61 63 65 68 6f 6c 64 65 s the placeholde
2e80: 72 20 66 6f 72 20 74 68 65 20 72 65 73 75 6c 74 r for the result
2e90: 2e 0a 3b 0a 3b 20 49 74 20 73 65 65 6d 73 20 74 ..;.; It seems t
2ea0: 68 61 74 20 74 68 65 20 6d 6f 73 74 20 6d 6f 64 hat the most mod
2eb0: 75 6c 61 72 20 77 61 79 20 74 6f 20 77 72 69 74 ular way to writ
2ec0: 65 20 74 68 65 20 72 75 6e 2d 74 65 73 74 20 6d e the run-test m
2ed0: 61 63 72 6f 20 77 6f 75 6c 64 0a 3b 20 62 65 20 acro would.; be
2ee0: 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 0a 3b 0a the following.;.
2ef0: 3b 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ; (define-syntax
2f00: 20 72 75 6e 2d 74 65 73 74 0a 3b 20 20 28 73 79 run-test.; (sy
2f10: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 3b 20 ntax-rules ().;
2f20: 20 20 28 28 72 75 6e 2d 74 65 73 74 20 2e 20 3f ((run-test . ?
2f30: 62 6f 64 79 29 0a 3b 20 20 20 20 20 28 6c 65 74 body).; (let
2f40: 72 65 63 2d 73 79 6e 74 61 78 0a 3b 20 20 20 20 rec-syntax.;
2f50: 20 20 20 28 28 73 63 61 6e 2d 65 78 70 09 09 09 ((scan-exp...
2f60: 3b 20 28 73 63 61 6e 2d 65 78 70 20 62 6f 64 79 ; (scan-exp body
2f70: 20 6b 29 0a 3b 20 09 20 28 73 79 6e 74 61 78 2d k).; . (syntax-
2f80: 72 75 6c 65 73 20 28 71 75 6f 74 65 20 71 75 61 rules (quote qua
2f90: 73 69 71 75 6f 74 65 20 21 29 0a 3b 20 09 20 20 siquote !).; .
2fa0: 20 28 28 73 63 61 6e 2d 65 78 70 20 28 71 75 6f ((scan-exp (quo
2fb0: 74 65 20 28 68 64 20 2e 20 74 6c 29 29 20 6b 29 te (hd . tl)) k)
2fc0: 0a 3b 20 09 20 20 20 20 20 28 73 63 61 6e 2d 6c .; . (scan-l
2fd0: 69 74 2d 6c 73 74 20 28 68 64 20 2e 20 74 6c 29 it-lst (hd . tl)
2fe0: 20 28 64 6f 2d 77 72 61 70 20 21 20 71 75 61 73 (do-wrap ! quas
2ff0: 69 71 75 6f 74 65 20 6b 29 29 29 0a 3b 20 09 20 iquote k))).; .
3000: 20 20 28 28 73 63 61 6e 2d 65 78 70 20 28 71 75 ((scan-exp (qu
3010: 6f 74 65 20 78 29 20 28 6b 2d 68 65 61 64 20 21 ote x) (k-head !
3020: 20 2e 20 61 72 67 73 29 29 0a 3b 20 09 20 20 20 . args)).; .
3030: 20 20 28 6b 2d 68 65 61 64 20 0a 3b 20 09 20 20 (k-head .; .
3040: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
3050: 3f 20 28 71 75 6f 74 65 20 78 29 29 20 28 73 74 ? (quote x)) (st
3060: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 71 75 ring->symbol (qu
3070: 6f 74 65 20 78 29 29 20 28 71 75 6f 74 65 20 78 ote x)) (quote x
3080: 29 29 0a 3b 20 09 20 20 20 20 20 20 20 2e 20 61 )).; . . a
3090: 72 67 73 29 29 0a 3b 20 09 20 20 20 28 28 73 63 rgs)).; . ((sc
30a0: 61 6e 2d 65 78 70 20 28 68 64 20 2e 20 74 6c 29 an-exp (hd . tl)
30b0: 20 6b 29 0a 3b 20 09 20 20 20 20 20 28 73 63 61 k).; . (sca
30c0: 6e 2d 65 78 70 20 68 64 20 28 64 6f 2d 74 6c 20 n-exp hd (do-tl
30d0: 21 20 73 63 61 6e 2d 65 78 70 20 74 6c 20 6b 29 ! scan-exp tl k)
30e0: 29 29 0a 3b 20 09 20 20 20 28 28 73 63 61 6e 2d )).; . ((scan-
30f0: 65 78 70 20 78 20 28 6b 2d 68 65 61 64 20 21 20 exp x (k-head !
3100: 2e 20 61 72 67 73 29 29 0a 3b 20 09 20 20 20 20 . args)).; .
3110: 20 28 6b 2d 68 65 61 64 20 78 20 2e 20 61 72 67 (k-head x . arg
3120: 73 29 29 29 29 0a 3b 20 09 28 64 6f 2d 74 6c 0a s)))).; .(do-tl.
3130: 3b 20 09 20 20 28 73 79 6e 74 61 78 2d 72 75 6c ; . (syntax-rul
3140: 65 73 20 28 21 29 0a 3b 20 09 20 20 20 20 28 28 es (!).; . ((
3150: 64 6f 2d 74 6c 20 70 72 6f 63 65 73 73 65 64 2d do-tl processed-
3160: 68 64 20 66 6e 20 28 29 20 28 6b 2d 68 65 61 64 hd fn () (k-head
3170: 20 21 20 2e 20 61 72 67 73 29 29 0a 3b 20 09 20 ! . args)).; .
3180: 20 20 20 20 20 28 6b 2d 68 65 61 64 20 28 70 72 (k-head (pr
3190: 6f 63 65 73 73 65 64 2d 68 64 29 20 2e 20 61 72 ocessed-hd) . ar
31a0: 67 73 29 29 0a 3b 20 09 20 20 20 20 28 28 64 6f gs)).; . ((do
31b0: 2d 74 6c 20 70 72 6f 63 65 73 73 65 64 2d 68 64 -tl processed-hd
31c0: 20 66 6e 20 6f 6c 64 2d 74 6c 20 6b 29 0a 3b 20 fn old-tl k).;
31d0: 09 20 20 20 20 20 20 28 66 6e 20 6f 6c 64 2d 74 . (fn old-t
31e0: 6c 20 28 64 6f 2d 63 6f 6e 73 20 21 20 70 72 6f l (do-cons ! pro
31f0: 63 65 73 73 65 64 2d 68 64 20 6b 29 29 29 29 29 cessed-hd k)))))
3200: 0a 3b 20 09 2e 2e 2e 0a 3b 20 09 28 64 6f 2d 66 .; .....; .(do-f
3210: 69 6e 69 73 68 0a 3b 20 09 20 20 28 73 79 6e 74 inish.; . (synt
3220: 61 78 2d 72 75 6c 65 73 20 28 29 0a 3b 20 09 20 ax-rules ().; .
3230: 20 20 20 28 28 64 6f 2d 66 69 6e 69 73 68 20 28 ((do-finish (
3240: 6e 65 77 2d 62 6f 64 79 29 29 20 6e 65 77 2d 62 new-body)) new-b
3250: 6f 64 79 29 0a 3b 20 09 20 20 20 20 28 28 64 6f ody).; . ((do
3260: 2d 66 69 6e 69 73 68 20 6e 65 77 2d 62 6f 64 79 -finish new-body
3270: 29 20 28 62 65 67 69 6e 20 2e 20 6e 65 77 2d 62 ) (begin . new-b
3280: 6f 64 79 29 29 29 29 0a 3b 20 09 2e 2e 2e 0a 3b ody)))).; .....;
3290: 20 20 20 20 20 20 20 28 73 63 61 6e 2d 65 78 70 (scan-exp
32a0: 20 3f 62 6f 64 79 20 28 64 6f 2d 66 69 6e 69 73 ?body (do-finis
32b0: 68 20 21 29 29 0a 3b 20 29 29 29 29 0a 3b 0a 3b h !)).; )))).;.;
32c0: 20 41 6c 61 73 2c 20 74 68 61 74 20 64 6f 65 73 Alas, that does
32d0: 6e 27 74 20 77 6f 72 6b 20 6f 6e 20 61 6c 6c 20 n't work on all
32e0: 73 79 73 74 65 6d 73 2e 20 57 65 20 68 69 74 20 systems. We hit
32f0: 79 65 74 20 61 6e 6f 74 68 65 72 20 64 61 72 6b yet another dark
3300: 0a 3b 20 63 6f 72 6e 65 72 20 6f 66 20 74 68 65 .; corner of the
3310: 20 52 35 52 53 20 6d 61 63 72 6f 73 2e 20 54 68 R5RS macros. Th
3320: 65 20 72 65 61 73 6f 6e 20 69 73 20 74 68 61 74 e reason is that
3330: 20 72 75 6e 2d 74 65 73 74 20 69 73 20 75 73 65 run-test is use
3340: 64 20 69 6e 0a 3b 20 74 68 65 20 63 6f 64 65 20 d in.; the code
3350: 62 65 6c 6f 77 20 74 6f 20 69 6e 74 72 6f 64 75 below to introdu
3360: 63 65 20 64 65 66 69 6e 69 74 69 6f 6e 73 2e 20 ce definitions.
3370: 46 6f 72 20 65 78 61 6d 70 6c 65 3a 0a 3b 20 28 For example:.; (
3380: 72 75 6e 2d 74 65 73 74 0a 3b 20 20 28 64 65 66 run-test.; (def
3390: 69 6e 65 20 28 73 73 61 78 3a 77 61 72 6e 20 70 ine (ssax:warn p
33a0: 6f 72 74 20 6d 73 67 20 2e 20 6f 74 68 65 72 2d ort msg . other-
33b0: 6d 73 67 29 0a 3b 20 20 20 20 28 61 70 70 6c 79 msg).; (apply
33c0: 20 63 65 72 72 20 28 63 6f 6e 73 2a 20 6e 6c 20 cerr (cons* nl
33d0: 22 57 61 72 6e 69 6e 67 3a 20 22 20 6d 73 67 20 "Warning: " msg
33e0: 6f 74 68 65 72 2d 6d 73 67 29 29 29 0a 3b 20 29 other-msg))).; )
33f0: 0a 3b 20 54 68 69 73 20 63 6f 64 65 20 65 78 70 .; This code exp
3400: 61 6e 64 73 20 74 6f 0a 3b 20 28 62 65 67 69 6e ands to.; (begin
3410: 0a 3b 20 20 20 20 28 64 65 66 69 6e 65 20 28 73 .; (define (s
3420: 73 61 78 3a 77 61 72 6e 20 70 6f 72 74 20 6d 73 sax:warn port ms
3430: 67 20 2e 20 6f 74 68 65 72 2d 6d 73 67 29 20 2e g . other-msg) .
3440: 2e 2e 29 29 0a 3b 20 73 6f 20 74 68 65 20 64 65 ..)).; so the de
3450: 66 69 6e 69 74 69 6f 6e 20 67 65 74 73 20 73 70 finition gets sp
3460: 6c 69 63 65 64 20 69 6e 20 69 6e 74 6f 20 74 68 liced in into th
3470: 65 20 74 6f 70 20 6c 65 76 65 6c 2e 20 52 69 67 e top level. Rig
3480: 68 74 3f 0a 3b 20 57 65 6c 6c 2c 20 4f 6e 20 50 ht?.; Well, On P
3490: 65 74 69 74 65 20 43 68 65 7a 20 53 63 68 65 6d etite Chez Schem
34a0: 65 20 69 74 20 69 73 20 73 6f 2e 20 48 6f 77 65 e it is so. Howe
34b0: 76 65 72 2c 20 6d 61 6e 79 20 6f 74 68 65 72 20 ver, many other
34c0: 73 79 73 74 65 6d 73 0a 3b 20 64 6f 6e 27 74 20 systems.; don't
34d0: 6c 69 6b 65 20 74 68 69 73 20 61 70 70 72 6f 61 like this approa
34e0: 63 68 2e 20 54 68 65 20 72 65 61 73 6f 6e 20 69 ch. The reason i
34f0: 73 20 74 68 61 74 20 74 68 65 20 69 6e 76 6f 63 s that the invoc
3500: 61 74 69 6f 6e 20 6f 66 0a 3b 20 28 72 75 6e 2d ation of.; (run-
3510: 74 65 73 74 20 28 64 65 66 69 6e 65 20 28 73 73 test (define (ss
3520: 61 78 3a 77 61 72 6e 20 70 6f 72 74 20 6d 73 67 ax:warn port msg
3530: 20 2e 20 6f 74 68 65 72 2d 6d 73 67 29 20 2e 2e . other-msg) ..
3540: 2e 29 29 0a 3b 20 66 69 72 73 74 20 65 78 70 61 .)).; first expa
3550: 6e 64 73 20 69 6e 74 6f 0a 3b 20 28 6c 65 74 72 nds into.; (letr
3560: 65 63 2d 73 79 6e 74 61 78 20 28 2e 2e 2e 29 20 ec-syntax (...)
3570: 0a 3b 20 20 20 28 73 63 61 6e 2d 65 78 70 20 28 .; (scan-exp (
3580: 28 64 65 66 69 6e 65 20 28 73 73 61 78 3a 77 61 (define (ssax:wa
3590: 72 6e 20 70 6f 72 74 20 6d 73 67 20 2e 20 6f 74 rn port msg . ot
35a0: 68 65 72 2d 6d 73 67 29 20 2e 2e 2e 29 29 20 2e her-msg) ...)) .
35b0: 2e 2e 29 29 0a 3b 20 62 65 63 61 75 73 65 20 6f ..)).; because o
35c0: 66 20 74 68 65 20 70 72 65 73 65 6e 63 65 20 6f f the presence o
35d0: 66 20 28 6c 65 74 72 65 63 2d 73 79 6e 74 61 78 f (letrec-syntax
35e0: 20 2e 2e 2e 29 2c 20 74 68 65 20 62 65 67 69 6e ...), the begin
35f0: 20 66 6f 72 6d 20 74 68 61 74 0a 3b 20 69 73 20 form that.; is
3600: 67 65 6e 65 72 61 74 65 64 20 65 76 65 6e 74 75 generated eventu
3610: 61 6c 6c 79 20 69 73 20 6e 6f 20 6c 6f 6e 67 65 ally is no longe
3620: 72 20 61 74 20 74 68 65 20 74 6f 70 20 6c 65 76 r at the top lev
3630: 65 6c 21 20 54 68 65 20 62 65 67 69 6e 0a 3b 20 el! The begin.;
3640: 66 6f 72 6d 20 69 6e 20 53 63 68 65 6d 65 20 69 form in Scheme i
3650: 73 20 61 6e 20 6f 76 65 72 6c 6f 61 64 69 6e 67 s an overloading
3660: 20 6f 66 20 74 77 6f 20 64 69 73 74 69 6e 63 74 of two distinct
3670: 20 66 6f 72 6d 73 3a 20 74 6f 70 2d 6c 65 76 65 forms: top-leve
3680: 6c 0a 3b 20 62 65 67 69 6e 20 61 6e 64 20 74 68 l.; begin and th
3690: 65 20 6f 74 68 65 72 20 62 65 67 69 6e 2e 20 54 e other begin. T
36a0: 68 65 20 66 6f 72 6d 73 20 68 61 76 65 20 64 69 he forms have di
36b0: 66 66 65 72 65 6e 74 20 72 75 6c 65 73 3a 20 66 fferent rules: f
36c0: 6f 72 20 65 78 61 6d 70 6c 65 2c 0a 3b 20 28 62 or example,.; (b
36d0: 65 67 69 6e 20 28 64 65 66 69 6e 65 20 78 20 31 egin (define x 1
36e0: 29 29 20 69 73 20 4f 4b 20 66 6f 72 20 61 20 74 )) is OK for a t
36f0: 6f 70 2d 6c 65 76 65 6c 20 62 65 67 69 6e 20 62 op-level begin b
3700: 75 74 20 6e 6f 74 20 4f 4b 20 66 6f 72 0a 3b 20 ut not OK for.;
3710: 74 68 65 20 6f 74 68 65 72 20 62 65 67 69 6e 2e the other begin.
3720: 20 53 6f 6d 65 20 53 63 68 65 6d 65 20 73 79 73 Some Scheme sys
3730: 74 65 6d 73 20 73 65 65 20 74 68 65 20 74 68 61 tems see the tha
3740: 74 20 74 68 65 20 6d 61 63 72 6f 0a 3b 20 28 72 t the macro.; (r
3750: 75 6e 2d 74 65 73 74 20 2e 2e 2e 29 20 65 78 70 un-test ...) exp
3760: 61 6e 64 73 20 69 6e 74 6f 20 28 6c 65 74 72 65 ands into (letre
3770: 63 2d 73 79 6e 74 61 78 20 2e 2e 2e 29 20 61 6e c-syntax ...) an
3780: 64 20 64 65 63 69 64 65 20 72 69 67 68 74 20 74 d decide right t
3790: 68 65 72 65 0a 3b 20 74 68 61 74 20 61 6e 79 20 here.; that any
37a0: 66 75 72 74 68 65 72 20 28 62 65 67 69 6e 20 2e further (begin .
37b0: 2e 2e 29 20 66 6f 72 6d 73 20 61 72 65 20 4e 4f ..) forms are NO
37c0: 54 20 74 6f 70 2d 6c 65 76 65 6c 20 62 65 67 69 T top-level begi
37d0: 6e 20 66 6f 72 6d 73 2e 0a 3b 20 54 68 65 20 6f n forms..; The o
37e0: 6e 6c 79 20 77 61 79 20 6f 75 74 20 69 73 20 74 nly way out is t
37f0: 6f 20 6d 61 6b 65 20 73 75 72 65 20 61 6c 6c 20 o make sure all
3800: 6f 75 72 20 6d 61 63 72 6f 73 20 61 72 65 20 74 our macros are t
3810: 6f 70 2d 6c 65 76 65 6c 2e 0a 3b 20 54 68 65 20 op-level..; The
3820: 62 65 73 74 20 61 70 70 72 6f 61 63 68 20 3c 73 best approach <s
3830: 69 67 68 3e 20 73 65 65 6d 73 20 74 6f 20 62 65 igh> seems to be
3840: 20 74 6f 20 6d 61 6b 65 20 72 75 6e 2d 74 65 73 to make run-tes
3850: 74 20 6f 6e 65 20 68 75 67 65 0a 3b 20 74 6f 70 t one huge.; top
3860: 2d 6c 65 76 65 6c 20 6d 61 63 72 6f 2e 0a 0a 0a -level macro....
3870: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
3880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
38a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
38b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 09 09 09 09 44 =========.;....D
38c0: 61 74 61 20 54 79 70 65 73 0a 0a 3b 20 54 41 47 ata Types..; TAG
38d0: 2d 4b 49 4e 44 0a 3b 09 61 20 73 79 6d 62 6f 6c -KIND.;.a symbol
38e0: 20 27 53 54 41 52 54 2c 20 27 45 4e 44 2c 20 27 'START, 'END, '
38f0: 50 49 2c 20 27 44 45 43 4c 2c 20 27 43 4f 4d 4d PI, 'DECL, 'COMM
3900: 45 4e 54 2c 20 27 43 44 53 45 43 54 0a 3b 09 09 ENT, 'CDSECT.;..
3910: 6f 72 20 27 45 4e 54 49 54 59 2d 52 45 46 20 74 or 'ENTITY-REF t
3920: 68 61 74 20 69 64 65 6e 74 69 66 69 65 73 20 61 hat identifies a
3930: 20 6d 61 72 6b 75 70 20 74 6f 6b 65 6e 0a 0a 3b markup token..;
3940: 20 55 4e 52 45 53 2d 4e 41 4d 45 0a 3b 09 61 20 UNRES-NAME.;.a
3950: 6e 61 6d 65 20 28 63 61 6c 6c 65 64 20 47 49 20 name (called GI
3960: 69 6e 20 74 68 65 20 58 4d 4c 20 52 65 63 6f 6d in the XML Recom
3970: 6d 65 6e 64 61 74 69 6f 6e 29 20 61 73 20 67 69 mendation) as gi
3980: 76 65 6e 20 69 6e 20 61 6e 20 78 6d 6c 0a 3b 09 ven in an xml.;.
3990: 64 6f 63 75 6d 65 6e 74 20 66 6f 72 20 61 20 6d document for a m
39a0: 61 72 6b 75 70 20 74 6f 6b 65 6e 3a 20 73 74 61 arkup token: sta
39b0: 72 74 2d 74 61 67 2c 20 50 49 20 74 61 72 67 65 rt-tag, PI targe
39c0: 74 2c 20 61 74 74 72 69 62 75 74 65 20 6e 61 6d t, attribute nam
39d0: 65 2e 0a 3b 09 49 66 20 61 20 47 49 20 69 73 20 e..;.If a GI is
39e0: 61 6e 20 4e 43 4e 61 6d 65 2c 20 55 4e 52 45 53 an NCName, UNRES
39f0: 2d 4e 41 4d 45 20 69 73 20 74 68 69 73 20 4e 43 -NAME is this NC
3a00: 4e 61 6d 65 20 63 6f 6e 76 65 72 74 65 64 20 69 Name converted i
3a10: 6e 74 6f 0a 3b 09 61 20 53 63 68 65 6d 65 20 73 nto.;.a Scheme s
3a20: 79 6d 62 6f 6c 2e 20 49 66 20 61 20 47 49 20 69 ymbol. If a GI i
3a30: 73 20 61 20 51 4e 61 6d 65 2c 20 55 4e 52 45 53 s a QName, UNRES
3a40: 2d 4e 41 4d 45 20 69 73 20 61 20 70 61 69 72 20 -NAME is a pair
3a50: 6f 66 0a 3b 09 73 79 6d 62 6f 6c 73 3a 20 28 50 of.;.symbols: (P
3a60: 52 45 46 49 58 20 2e 20 4c 4f 43 41 4c 50 41 52 REFIX . LOCALPAR
3a70: 54 29 0a 0a 3b 20 52 45 53 2d 4e 41 4d 45 0a 3b T)..; RES-NAME.;
3a80: 09 41 6e 20 65 78 70 61 6e 64 65 64 20 6e 61 6d .An expanded nam
3a90: 65 2c 20 61 20 72 65 73 6f 6c 76 65 64 20 76 65 e, a resolved ve
3aa0: 72 73 69 6f 6e 20 6f 66 20 61 6e 20 55 4e 52 45 rsion of an UNRE
3ab0: 53 2d 4e 41 4d 45 2e 0a 3b 09 46 6f 72 20 61 6e S-NAME..;.For an
3ac0: 20 65 6c 65 6d 65 6e 74 20 6f 72 20 61 6e 20 61 element or an a
3ad0: 74 74 72 69 62 75 74 65 20 6e 61 6d 65 20 77 69 ttribute name wi
3ae0: 74 68 20 61 20 6e 6f 6e 2d 65 6d 70 74 79 20 6e th a non-empty n
3af0: 61 6d 65 73 70 61 63 65 20 55 52 49 2c 0a 3b 09 amespace URI,.;.
3b00: 52 45 53 2d 4e 41 4d 45 20 69 73 20 61 20 70 61 RES-NAME is a pa
3b10: 69 72 20 6f 66 20 73 79 6d 62 6f 6c 73 2c 20 28 ir of symbols, (
3b20: 55 52 49 2d 53 59 4d 42 20 2e 20 4c 4f 43 41 4c URI-SYMB . LOCAL
3b30: 50 41 52 54 29 2e 0a 3b 09 4f 74 68 65 72 77 69 PART)..;.Otherwi
3b40: 73 65 2c 20 69 74 27 73 20 61 20 73 69 6e 67 6c se, it's a singl
3b50: 65 20 73 79 6d 62 6f 6c 2e 0a 0a 3b 20 45 4c 45 e symbol...; ELE
3b60: 4d 2d 43 4f 4e 54 45 4e 54 2d 4d 4f 44 45 4c 0a M-CONTENT-MODEL.
3b70: 3b 09 41 20 73 79 6d 62 6f 6c 3a 0a 3b 09 41 4e ;.A symbol:.;.AN
3b80: 59 09 20 20 2d 20 61 6e 79 74 68 69 6e 67 20 67 Y. - anything g
3b90: 6f 65 73 2c 20 65 78 70 65 63 74 20 61 6e 20 45 oes, expect an E
3ba0: 4e 44 20 74 61 67 2e 0a 3b 09 45 4d 50 54 59 2d ND tag..;.EMPTY-
3bb0: 54 41 47 20 2d 20 6e 6f 20 63 6f 6e 74 65 6e 74 TAG - no content
3bc0: 2c 20 61 6e 64 20 6e 6f 20 45 4e 44 2d 74 61 67 , and no END-tag
3bd0: 20 69 73 20 63 6f 6d 69 6e 67 0a 3b 09 45 4d 50 is coming.;.EMP
3be0: 54 59 09 20 20 2d 20 6e 6f 20 63 6f 6e 74 65 6e TY. - no conten
3bf0: 74 2c 20 65 78 70 65 63 74 20 74 68 65 20 45 4e t, expect the EN
3c00: 44 2d 74 61 67 20 61 73 20 74 68 65 20 6e 65 78 D-tag as the nex
3c10: 74 20 74 6f 6b 65 6e 0a 3b 09 50 43 44 41 54 41 t token.;.PCDATA
3c20: 20 20 20 20 2d 20 65 78 70 65 63 74 20 63 68 61 - expect cha
3c30: 72 61 63 74 65 72 20 64 61 74 61 20 6f 6e 6c 79 racter data only
3c40: 2c 20 61 6e 64 20 6e 6f 20 63 68 69 6c 64 72 65 , and no childre
3c50: 6e 20 65 6c 65 6d 65 6e 74 73 0a 3b 09 4d 49 58 n elements.;.MIX
3c60: 45 44 0a 3b 09 45 4c 45 4d 2d 43 4f 4e 54 45 4e ED.;.ELEM-CONTEN
3c70: 54 0a 0a 3b 20 55 52 49 2d 53 59 4d 42 0a 3b 09 T..; URI-SYMB.;.
3c80: 41 20 73 79 6d 62 6f 6c 20 72 65 70 72 65 73 65 A symbol represe
3c90: 6e 74 69 6e 67 20 61 20 6e 61 6d 65 73 70 61 63 nting a namespac
3ca0: 65 20 55 52 49 20 2d 2d 20 6f 72 20 6f 74 68 65 e URI -- or othe
3cb0: 72 20 73 79 6d 62 6f 6c 20 63 68 6f 73 65 6e 0a r symbol chosen.
3cc0: 3b 09 62 79 20 74 68 65 20 75 73 65 72 20 74 6f ;.by the user to
3cd0: 20 72 65 70 72 65 73 65 6e 74 20 55 52 49 2e 20 represent URI.
3ce0: 49 6e 20 74 68 65 20 66 6f 72 6d 65 72 20 63 61 In the former ca
3cf0: 73 65 2c 0a 3b 09 55 52 49 2d 53 59 4d 42 20 69 se,.;.URI-SYMB i
3d00: 73 20 63 72 65 61 74 65 64 20 62 79 20 25 2d 71 s created by %-q
3d10: 75 6f 74 69 6e 67 20 6f 66 20 62 61 64 20 55 52 uoting of bad UR
3d20: 49 20 63 68 61 72 61 63 74 65 72 73 20 61 6e 64 I characters and
3d30: 0a 3b 09 63 6f 6e 76 65 72 74 69 6e 67 20 74 68 .;.converting th
3d40: 65 20 72 65 73 75 6c 74 69 6e 67 20 73 74 72 69 e resulting stri
3d50: 6e 67 20 69 6e 74 6f 20 61 20 73 79 6d 62 6f 6c ng into a symbol
3d60: 2e 0a 0a 3b 20 4e 41 4d 45 53 50 41 43 45 53 0a ...; NAMESPACES.
3d70: 3b 09 41 20 6c 69 73 74 20 72 65 70 72 65 73 65 ;.A list represe
3d80: 6e 74 69 6e 67 20 6e 61 6d 65 73 70 61 63 65 73 nting namespaces
3d90: 20 69 6e 20 65 66 66 65 63 74 2e 20 41 6e 20 65 in effect. An e
3da0: 6c 65 6d 65 6e 74 20 6f 66 20 74 68 65 20 6c 69 lement of the li
3db0: 73 74 0a 3b 09 68 61 73 20 6f 6e 65 20 6f 66 20 st.;.has one of
3dc0: 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 66 6f the following fo
3dd0: 72 6d 73 3a 0a 3b 09 28 50 52 45 46 49 58 20 55 rms:.;.(PREFIX U
3de0: 52 49 2d 53 59 4d 42 20 2e 20 55 52 49 2d 53 59 RI-SYMB . URI-SY
3df0: 4d 42 29 20 6f 72 0a 3b 09 28 50 52 45 46 49 58 MB) or.;.(PREFIX
3e00: 20 55 53 45 52 2d 50 52 45 46 49 58 20 2e 20 55 USER-PREFIX . U
3e10: 52 49 2d 53 59 4d 42 29 0a 3b 09 09 55 53 45 52 RI-SYMB).;..USER
3e20: 2d 50 52 45 46 49 58 20 69 73 20 61 20 73 79 6d -PREFIX is a sym
3e30: 62 6f 6c 20 63 68 6f 73 65 6e 20 62 79 20 74 68 bol chosen by th
3e40: 65 20 75 73 65 72 0a 3b 09 09 74 6f 20 72 65 70 e user.;..to rep
3e50: 72 65 73 65 6e 74 20 74 68 65 20 55 52 49 2e 0a resent the URI..
3e60: 3b 09 28 23 66 20 55 53 45 52 2d 50 52 45 46 49 ;.(#f USER-PREFI
3e70: 58 20 2e 20 55 52 49 2d 53 59 4d 42 29 0a 3b 09 X . URI-SYMB).;.
3e80: 09 53 70 65 63 69 66 69 63 61 74 69 6f 6e 20 6f .Specification o
3e90: 66 20 74 68 65 20 75 73 65 72 2d 63 68 6f 73 65 f the user-chose
3ea0: 6e 20 70 72 65 66 69 78 20 61 6e 64 20 61 20 55 n prefix and a U
3eb0: 52 49 2d 53 59 4d 42 4f 4c 2e 0a 3b 09 28 2a 44 RI-SYMBOL..;.(*D
3ec0: 45 46 41 55 4c 54 2a 20 55 53 45 52 2d 50 52 45 EFAULT* USER-PRE
3ed0: 46 49 58 20 2e 20 55 52 49 2d 53 59 4d 42 29 0a FIX . URI-SYMB).
3ee0: 3b 09 09 44 65 63 6c 61 72 61 74 69 6f 6e 20 6f ;..Declaration o
3ef0: 66 20 74 68 65 20 64 65 66 61 75 6c 74 20 6e 61 f the default na
3f00: 6d 65 73 70 61 63 65 0a 3b 09 28 2a 44 45 46 41 mespace.;.(*DEFA
3f10: 55 4c 54 2a 20 23 66 20 2e 20 23 66 29 0a 3b 09 ULT* #f . #f).;.
3f20: 09 55 6e 2d 64 65 63 6c 61 72 61 74 69 6f 6e 20 .Un-declaration
3f30: 6f 66 20 74 68 65 20 64 65 66 61 75 6c 74 20 6e of the default n
3f40: 61 6d 65 73 70 61 63 65 2e 20 54 68 69 73 20 6e amespace. This n
3f50: 6f 74 61 74 69 6f 6e 0a 3b 09 09 72 65 70 72 65 otation.;..repre
3f60: 73 65 6e 74 73 20 6f 76 65 72 72 69 64 69 6e 67 sents overriding
3f70: 20 6f 66 20 74 68 65 20 70 72 65 76 69 6f 75 73 of the previous
3f80: 20 64 65 63 6c 61 72 61 74 69 6f 6e 0a 3b 09 41 declaration.;.A
3f90: 20 4e 41 4d 45 53 50 41 43 45 53 20 6c 69 73 74 NAMESPACES list
3fa0: 20 6d 61 79 20 63 6f 6e 74 61 69 6e 20 73 65 76 may contain sev
3fb0: 65 72 61 6c 20 65 6c 65 6d 65 6e 74 73 20 66 6f eral elements fo
3fc0: 72 20 74 68 65 20 73 61 6d 65 20 50 52 45 46 49 r the same PREFI
3fd0: 58 2e 0a 3b 09 54 68 65 20 6f 6e 65 20 63 6c 6f X..;.The one clo
3fe0: 73 65 73 74 20 74 6f 20 74 68 65 20 62 65 67 69 sest to the begi
3ff0: 6e 6e 69 6e 67 20 6f 66 20 74 68 65 20 6c 69 73 nning of the lis
4000: 74 20 74 61 6b 65 73 20 65 66 66 65 63 74 2e 0a t takes effect..
4010: 0a 3b 20 41 54 54 4c 49 53 54 0a 3b 09 41 6e 20 .; ATTLIST.;.An
4020: 6f 72 64 65 72 65 64 20 63 6f 6c 6c 65 63 74 69 ordered collecti
4030: 6f 6e 20 6f 66 20 28 4e 41 4d 45 20 2e 20 56 41 on of (NAME . VA
4040: 4c 55 45 29 20 70 61 69 72 73 2c 20 77 68 65 72 LUE) pairs, wher
4050: 65 20 4e 41 4d 45 20 69 73 0a 3b 09 61 20 52 45 e NAME is.;.a RE
4060: 53 2d 4e 41 4d 45 20 6f 72 20 61 6e 20 55 4e 52 S-NAME or an UNR
4070: 45 53 2d 4e 41 4d 45 2e 20 54 68 65 20 63 6f 6c ES-NAME. The col
4080: 6c 65 63 74 69 6f 6e 20 69 73 20 61 6e 20 41 44 lection is an AD
4090: 54 0a 0a 3b 20 53 54 52 2d 48 41 4e 44 4c 45 52 T..; STR-HANDLER
40a0: 0a 3b 09 41 20 70 72 6f 63 65 64 75 72 65 20 6f .;.A procedure o
40b0: 66 20 74 68 72 65 65 20 61 72 67 75 6d 65 6e 74 f three argument
40c0: 73 3a 20 53 54 52 49 4e 47 31 20 53 54 52 49 4e s: STRING1 STRIN
40d0: 47 32 20 53 45 45 44 0a 3b 09 72 65 74 75 72 6e G2 SEED.;.return
40e0: 69 6e 67 20 61 20 6e 65 77 20 53 45 45 44 0a 3b ing a new SEED.;
40f0: 09 54 68 65 20 70 72 6f 63 65 64 75 72 65 20 69 .The procedure i
4100: 73 20 73 75 70 70 6f 73 65 64 20 74 6f 20 68 61 s supposed to ha
4110: 6e 64 6c 65 20 61 20 63 68 75 6e 6b 20 6f 66 20 ndle a chunk of
4120: 63 68 61 72 61 63 74 65 72 20 64 61 74 61 0a 3b character data.;
4130: 09 53 54 52 49 4e 47 31 20 66 6f 6c 6c 6f 77 65 .STRING1 followe
4140: 64 20 62 79 20 61 20 63 68 75 6e 6b 20 6f 66 20 d by a chunk of
4150: 63 68 61 72 61 63 74 65 72 20 64 61 74 61 20 53 character data S
4160: 54 52 49 4e 47 32 2e 0a 3b 09 53 54 52 49 4e 47 TRING2..;.STRING
4170: 32 20 69 73 20 61 20 73 68 6f 72 74 20 73 74 72 2 is a short str
4180: 69 6e 67 2c 20 6f 66 74 65 6e 20 22 5c 6e 22 20 ing, often "\n"
4190: 61 6e 64 20 65 76 65 6e 20 22 22 0a 0a 3b 20 45 and even ""..; E
41a0: 4e 54 49 54 49 45 53 0a 3b 09 41 6e 20 61 73 73 NTITIES.;.An ass
41b0: 6f 63 20 6c 69 73 74 20 6f 66 20 70 61 69 72 73 oc list of pairs
41c0: 3a 0a 3b 09 20 20 20 28 6e 61 6d 65 64 2d 65 6e :.;. (named-en
41d0: 74 69 74 79 2d 6e 61 6d 65 20 2e 20 6e 61 6d 65 tity-name . name
41e0: 64 2d 65 6e 74 69 74 79 2d 62 6f 64 79 29 0a 3b d-entity-body).;
41f0: 09 77 68 65 72 65 20 6e 61 6d 65 64 2d 65 6e 74 .where named-ent
4200: 69 74 79 2d 6e 61 6d 65 20 69 73 20 61 20 73 79 ity-name is a sy
4210: 6d 62 6f 6c 20 75 6e 64 65 72 20 77 68 69 63 68 mbol under which
4220: 20 74 68 65 20 65 6e 74 69 74 79 20 77 61 73 0a the entity was.
4230: 3b 09 64 65 63 6c 61 72 65 64 2c 20 6e 61 6d 65 ;.declared, name
4240: 64 2d 65 6e 74 69 74 79 2d 62 6f 64 79 20 69 73 d-entity-body is
4250: 20 65 69 74 68 65 72 20 61 20 73 74 72 69 6e 67 either a string
4260: 2c 20 6f 72 0a 3b 09 28 66 6f 72 20 61 6e 20 65 , or.;.(for an e
4270: 78 74 65 72 6e 61 6c 20 65 6e 74 69 74 79 29 20 xternal entity)
4280: 61 20 74 68 75 6e 6b 20 74 68 61 74 20 77 69 6c a thunk that wil
4290: 6c 20 72 65 74 75 72 6e 20 61 6e 0a 3b 09 69 6e l return an.;.in
42a0: 70 75 74 20 70 6f 72 74 20 28 66 72 6f 6d 20 77 put port (from w
42b0: 68 69 63 68 20 74 68 65 20 65 6e 74 69 74 79 20 hich the entity
42c0: 63 61 6e 20 62 65 20 72 65 61 64 29 2e 0a 3b 09 can be read)..;.
42d0: 6e 61 6d 65 64 2d 65 6e 74 69 74 79 2d 62 6f 64 named-entity-bod
42e0: 79 20 6d 61 79 20 61 6c 73 6f 20 62 65 20 23 66 y may also be #f
42f0: 2e 20 54 68 69 73 20 69 73 20 61 6e 20 69 6e 64 . This is an ind
4300: 69 63 61 74 69 6f 6e 20 74 68 61 74 20 61 0a 3b ication that a.;
4310: 09 6e 61 6d 65 64 2d 65 6e 74 69 74 79 2d 6e 61 .named-entity-na
4320: 6d 65 20 69 73 20 63 75 72 72 65 6e 74 6c 79 20 me is currently
4330: 62 65 69 6e 67 20 65 78 70 61 6e 64 65 64 2e 20 being expanded.
4340: 41 20 72 65 66 65 72 65 6e 63 65 20 74 6f 0a 3b A reference to.;
4350: 09 74 68 69 73 20 6e 61 6d 65 64 2d 65 6e 74 69 .this named-enti
4360: 74 79 2d 6e 61 6d 65 20 77 69 6c 6c 20 62 65 20 ty-name will be
4370: 61 6e 20 65 72 72 6f 72 3a 20 76 69 6f 6c 61 74 an error: violat
4380: 69 6f 6e 20 6f 66 20 74 68 65 0a 3b 09 57 46 43 ion of the.;.WFC
4390: 20 6e 6f 6e 72 65 63 75 72 73 69 6f 6e 2e 0a 0a nonrecursion...
43a0: 3b 20 58 4d 4c 2d 54 4f 4b 45 4e 20 2d 2d 20 61 ; XML-TOKEN -- a
43b0: 20 72 65 63 6f 72 64 0a 0a 3b 20 49 6e 20 47 61 record..; In Ga
43c0: 6d 62 69 74 2c 20 79 6f 75 20 63 61 6e 20 75 73 mbit, you can us
43d0: 65 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 e the following
43e0: 64 65 63 6c 61 72 61 74 69 6f 6e 3a 0a 3b 20 28 declaration:.; (
43f0: 64 65 66 69 6e 65 2d 73 74 72 75 63 74 75 72 65 define-structure
4400: 20 78 6d 6c 2d 74 6f 6b 65 6e 20 6b 69 6e 64 20 xml-token kind
4410: 68 65 61 64 29 0a 3b 20 54 68 65 20 66 6f 6c 6c head).; The foll
4420: 6f 77 69 6e 67 20 64 65 63 6c 61 72 61 74 69 6f owing declaratio
4430: 6e 20 69 73 20 22 73 74 61 6e 64 61 72 64 22 20 n is "standard"
4440: 61 73 20 69 74 20 66 6f 6c 6c 6f 77 73 20 53 52 as it follows SR
4450: 46 49 2d 39 3a 0a 3b 3b 28 64 65 66 69 6e 65 2d FI-9:.;;(define-
4460: 72 65 63 6f 72 64 2d 74 79 70 65 20 20 78 6d 6c record-type xml
4470: 2d 74 6f 6b 65 6e 20 20 28 6d 61 6b 65 2d 78 6d -token (make-xm
4480: 6c 2d 74 6f 6b 65 6e 20 6b 69 6e 64 20 68 65 61 l-token kind hea
4490: 64 29 20 20 78 6d 6c 2d 74 6f 6b 65 6e 3f 0a 3b d) xml-token?.;
44a0: 3b 20 20 28 6b 69 6e 64 20 20 78 6d 6c 2d 74 6f ; (kind xml-to
44b0: 6b 65 6e 2d 6b 69 6e 64 29 0a 3b 3b 20 20 28 68 ken-kind).;; (h
44c0: 65 61 64 20 20 78 6d 6c 2d 74 6f 6b 65 6e 2d 68 ead xml-token-h
44d0: 65 61 64 29 20 29 0a 3b 20 4e 6f 20 66 69 65 6c ead) ).; No fiel
44e0: 64 20 6d 75 74 61 74 6f 72 73 20 61 72 65 20 64 d mutators are d
44f0: 65 63 6c 61 72 65 64 20 61 73 20 53 53 41 58 20 eclared as SSAX
4500: 69 73 20 61 20 70 75 72 65 20 66 75 6e 63 74 69 is a pure functi
4510: 6f 6e 61 6c 20 70 61 72 73 65 72 0a 3b 0a 3b 20 onal parser.;.;
4520: 42 75 74 20 74 6f 20 6d 61 6b 65 20 74 68 65 20 But to make the
4530: 63 6f 64 65 20 6d 6f 72 65 20 70 6f 72 74 61 62 code more portab
4540: 6c 65 2c 20 77 65 20 64 65 66 69 6e 65 20 78 6d le, we define xm
4550: 6c 2d 74 6f 6b 65 6e 20 73 69 6d 70 6c 79 20 61 l-token simply a
4560: 73 0a 3b 20 61 20 70 61 69 72 2e 20 49 74 20 73 s.; a pair. It s
4570: 75 66 66 69 63 65 73 20 66 6f 72 20 75 73 2e 20 uffices for us.
4580: 46 75 72 74 68 65 72 6d 6f 72 65 2c 20 78 6d 6c Furthermore, xml
4590: 2d 74 6f 6b 65 6e 2d 6b 69 6e 64 20 61 6e 64 20 -token-kind and
45a0: 78 6d 6c 2d 74 6f 6b 65 6e 2d 68 65 61 64 0a 3b xml-token-head.;
45b0: 20 63 61 6e 20 62 65 20 64 65 66 69 6e 65 64 20 can be defined
45c0: 61 73 20 73 69 6d 70 6c 65 20 70 72 6f 63 65 64 as simple proced
45d0: 75 72 65 73 2e 20 48 6f 77 65 76 65 72 2c 20 74 ures. However, t
45e0: 68 65 79 20 61 72 65 20 64 65 63 6c 61 72 65 64 hey are declared
45f0: 20 61 73 0a 3b 20 6d 61 63 72 6f 73 20 62 65 6c as.; macros bel
4600: 6f 77 20 66 6f 72 20 65 66 66 69 63 69 65 6e 63 ow for efficienc
4610: 79 2e 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b y...(define (mak
4620: 65 2d 78 6d 6c 2d 74 6f 6b 65 6e 20 6b 69 6e 64 e-xml-token kind
4630: 20 68 65 61 64 29 20 28 63 6f 6e 73 20 6b 69 6e head) (cons kin
4640: 64 20 68 65 61 64 29 29 0a 28 64 65 66 69 6e 65 d head)).(define
4650: 20 78 6d 6c 2d 74 6f 6b 65 6e 3f 20 70 61 69 72 xml-token? pair
4660: 3f 29 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 ?).(define-synta
4670: 78 20 78 6d 6c 2d 74 6f 6b 65 6e 2d 6b 69 6e 64 x xml-token-kind
4680: 20 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 . (syntax-rule
4690: 73 20 28 29 20 28 28 78 6d 6c 2d 74 6f 6b 65 6e s () ((xml-token
46a0: 2d 6b 69 6e 64 20 74 6f 6b 65 6e 29 20 28 63 61 -kind token) (ca
46b0: 72 20 74 6f 6b 65 6e 29 29 29 29 0a 28 64 65 66 r token)))).(def
46c0: 69 6e 65 2d 73 79 6e 74 61 78 20 78 6d 6c 2d 74 ine-syntax xml-t
46d0: 6f 6b 65 6e 2d 68 65 61 64 20 0a 20 20 28 73 79 oken-head . (sy
46e0: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 20 28 28 ntax-rules () ((
46f0: 78 6d 6c 2d 74 6f 6b 65 6e 2d 68 65 61 64 20 74 xml-token-head t
4700: 6f 6b 65 6e 29 20 28 63 64 72 20 74 6f 6b 65 6e oken) (cdr token
4710: 29 29 29 29 0a 0a 3b 20 28 64 65 66 69 6e 65 2d ))))..; (define-
4720: 6d 61 63 72 6f 20 78 6d 6c 2d 74 6f 6b 65 6e 2d macro xml-token-
4730: 6b 69 6e 64 20 28 6c 61 6d 62 64 61 20 28 74 6f kind (lambda (to
4740: 6b 65 6e 29 20 60 28 63 61 72 20 2c 74 6f 6b 65 ken) `(car ,toke
4750: 6e 29 29 29 0a 3b 20 28 64 65 66 69 6e 65 2d 6d n))).; (define-m
4760: 61 63 72 6f 20 78 6d 6c 2d 74 6f 6b 65 6e 2d 68 acro xml-token-h
4770: 65 61 64 20 28 6c 61 6d 62 64 61 20 28 74 6f 6b ead (lambda (tok
4780: 65 6e 29 20 60 28 63 64 72 20 2c 74 6f 6b 65 6e en) `(cdr ,token
4790: 29 29 29 0a 0a 3b 20 54 68 69 73 20 72 65 63 6f )))..; This reco
47a0: 72 64 20 72 65 70 72 65 73 65 6e 74 73 20 61 20 rd represents a
47b0: 6d 61 72 6b 75 70 2c 20 77 68 69 63 68 20 69 73 markup, which is
47c0: 2c 20 61 63 63 6f 72 64 69 6e 67 20 74 6f 20 74 , according to t
47d0: 68 65 20 58 4d 4c 0a 3b 20 52 65 63 6f 6d 6d 65 he XML.; Recomme
47e0: 6e 64 61 74 69 6f 6e 2c 20 22 74 61 6b 65 73 20 ndation, "takes
47f0: 74 68 65 20 66 6f 72 6d 20 6f 66 20 73 74 61 72 the form of star
4800: 74 2d 74 61 67 73 2c 20 65 6e 64 2d 74 61 67 73 t-tags, end-tags
4810: 2c 20 65 6d 70 74 79 2d 65 6c 65 6d 65 6e 74 20 , empty-element
4820: 74 61 67 73 2c 0a 3b 20 65 6e 74 69 74 79 20 72 tags,.; entity r
4830: 65 66 65 72 65 6e 63 65 73 2c 20 63 68 61 72 61 eferences, chara
4840: 63 74 65 72 20 72 65 66 65 72 65 6e 63 65 73 2c cter references,
4850: 20 63 6f 6d 6d 65 6e 74 73 2c 20 43 44 41 54 41 comments, CDATA
4860: 20 73 65 63 74 69 6f 6e 20 64 65 6c 69 6d 69 74 section delimit
4870: 65 72 73 2c 0a 3b 20 64 6f 63 75 6d 65 6e 74 20 ers,.; document
4880: 74 79 70 65 20 64 65 63 6c 61 72 61 74 69 6f 6e type declaration
4890: 73 2c 20 61 6e 64 20 70 72 6f 63 65 73 73 69 6e s, and processin
48a0: 67 20 69 6e 73 74 72 75 63 74 69 6f 6e 73 2e 22 g instructions."
48b0: 0a 3b 0a 3b 09 6b 69 6e 64 20 2d 2d 20 61 20 54 .;.;.kind -- a T
48c0: 41 47 2d 4b 49 4e 44 0a 3b 09 68 65 61 64 20 2d AG-KIND.;.head -
48d0: 2d 20 61 6e 20 55 4e 52 45 53 2d 4e 41 4d 45 2e - an UNRES-NAME.
48e0: 20 46 6f 72 20 78 6d 6c 2d 74 6f 6b 65 6e 73 20 For xml-tokens
48f0: 6f 66 20 6b 69 6e 64 73 20 27 43 4f 4d 4d 45 4e of kinds 'COMMEN
4900: 54 20 61 6e 64 0a 3b 09 09 27 43 44 53 45 43 54 T and.;..'CDSECT
4910: 2c 20 74 68 65 20 68 65 61 64 20 69 73 20 23 66 , the head is #f
4920: 0a 3b 0a 3b 20 46 6f 72 20 65 78 61 6d 70 6c 65 .;.; For example
4930: 2c 0a 3b 09 3c 50 3e 20 20 3d 3e 20 6b 69 6e 64 ,.;.<P> => kind
4940: 3d 27 53 54 41 52 54 2c 20 68 65 61 64 3d 27 50 ='START, head='P
4950: 0a 3b 09 3c 2f 50 3e 20 3d 3e 20 6b 69 6e 64 3d .;.</P> => kind=
4960: 27 45 4e 44 2c 20 68 65 61 64 3d 27 50 0a 3b 09 'END, head='P.;.
4970: 3c 42 52 2f 3e 20 3d 3e 20 6b 69 6e 64 3d 27 45 <BR/> => kind='E
4980: 4d 50 54 59 2d 45 4c 2c 20 68 65 61 64 3d 27 42 MPTY-EL, head='B
4990: 52 0a 3b 09 3c 21 44 4f 43 54 59 50 45 20 4f 4d R.;.<!DOCTYPE OM
49a0: 46 20 2e 2e 2e 3e 20 3d 3e 20 6b 69 6e 64 3d 27 F ...> => kind='
49b0: 44 45 43 4c 2c 20 68 65 61 64 3d 27 44 4f 43 54 DECL, head='DOCT
49c0: 59 50 45 0a 3b 09 3c 3f 78 6d 6c 20 76 65 72 73 YPE.;.<?xml vers
49d0: 69 6f 6e 3d 22 31 2e 30 22 3f 3e 20 3d 3e 20 6b ion="1.0"?> => k
49e0: 69 6e 64 3d 27 50 49 2c 20 68 65 61 64 3d 27 78 ind='PI, head='x
49f0: 6d 6c 0a 3b 09 26 6d 79 2d 65 6e 74 3b 20 3d 3e ml.;.&my-ent; =>
4a00: 20 6b 69 6e 64 20 3d 20 27 45 4e 54 49 54 59 2d kind = 'ENTITY-
4a10: 52 45 46 2c 20 68 65 61 64 3d 27 6d 79 2d 65 6e REF, head='my-en
4a20: 74 0a 3b 20 0a 3b 20 43 68 61 72 61 63 74 65 72 t.; .; Character
4a30: 20 72 65 66 65 72 65 6e 63 65 73 20 61 72 65 20 references are
4a40: 6e 6f 74 20 72 65 70 72 65 73 65 6e 74 65 64 20 not represented
4a50: 62 79 20 78 6d 6c 2d 74 6f 6b 65 6e 73 20 61 73 by xml-tokens as
4a60: 20 74 68 65 73 65 20 72 65 66 65 72 65 6e 63 65 these reference
4a70: 73 0a 3b 20 61 72 65 20 74 72 61 6e 73 70 61 72 s.; are transpar
4a80: 65 6e 74 6c 79 20 72 65 73 6f 6c 76 65 64 20 69 ently resolved i
4a90: 6e 74 6f 20 74 68 65 20 63 6f 72 72 65 73 70 6f nto the correspo
4aa0: 6e 64 69 6e 67 20 63 68 61 72 61 63 74 65 72 73 nding characters
4ab0: 2e 0a 3b 0a 0a 0a 0a 3b 20 58 4d 4c 2d 44 45 43 ..;....; XML-DEC
4ac0: 4c 20 2d 2d 20 61 20 72 65 63 6f 72 64 0a 0a 3b L -- a record..;
4ad0: 20 54 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 69 The following i
4ae0: 73 20 47 61 6d 62 69 74 2d 73 70 65 63 69 66 69 s Gambit-specifi
4af0: 63 2c 20 73 65 65 20 62 65 6c 6f 77 20 66 6f 72 c, see below for
4b00: 20 61 20 70 6f 72 74 61 62 6c 65 20 64 65 63 6c a portable decl
4b10: 61 72 61 74 69 6f 6e 0a 3b 28 64 65 66 69 6e 65 aration.;(define
4b20: 2d 73 74 72 75 63 74 75 72 65 20 78 6d 6c 2d 64 -structure xml-d
4b30: 65 63 6c 20 65 6c 65 6d 73 20 65 6e 74 69 74 69 ecl elems entiti
4b40: 65 73 20 6e 6f 74 61 74 69 6f 6e 73 29 0a 0a 3b es notations)..;
4b50: 20 54 68 65 20 72 65 63 6f 72 64 20 72 65 70 72 The record repr
4b60: 65 73 65 6e 74 73 20 61 20 64 61 74 61 74 79 70 esents a datatyp
4b70: 65 20 6f 66 20 61 6e 20 58 4d 4c 20 64 6f 63 75 e of an XML docu
4b80: 6d 65 6e 74 3a 20 74 68 65 20 6c 69 73 74 20 6f ment: the list o
4b90: 66 0a 3b 20 64 65 63 6c 61 72 65 64 20 65 6c 65 f.; declared ele
4ba0: 6d 65 6e 74 73 20 61 6e 64 20 74 68 65 69 72 20 ments and their
4bb0: 61 74 74 72 69 62 75 74 65 73 2c 20 64 65 63 6c attributes, decl
4bc0: 61 72 65 64 20 6e 6f 74 61 74 69 6f 6e 73 2c 20 ared notations,
4bd0: 6c 69 73 74 20 6f 66 0a 3b 20 72 65 70 6c 61 63 list of.; replac
4be0: 65 6d 65 6e 74 20 73 74 72 69 6e 67 73 20 6f 72 ement strings or
4bf0: 20 6c 6f 61 64 69 6e 67 20 70 72 6f 63 65 64 75 loading procedu
4c00: 72 65 73 20 66 6f 72 20 70 61 72 73 65 64 20 67 res for parsed g
4c10: 65 6e 65 72 61 6c 0a 3b 20 65 6e 74 69 74 69 65 eneral.; entitie
4c20: 73 2c 20 65 74 63 2e 20 4e 6f 72 6d 61 6c 6c 79 s, etc. Normally
4c30: 20 61 6e 20 78 6d 6c 2d 64 65 63 6c 20 72 65 63 an xml-decl rec
4c40: 6f 72 64 20 69 73 20 63 72 65 61 74 65 64 20 66 ord is created f
4c50: 72 6f 6d 20 61 20 44 54 44 20 6f 72 0a 3b 20 61 rom a DTD or.; a
4c60: 6e 20 58 4d 4c 20 53 63 68 65 6d 61 2c 20 61 6c n XML Schema, al
4c70: 74 68 6f 75 67 68 20 69 74 20 63 61 6e 20 62 65 though it can be
4c80: 20 63 72 65 61 74 65 64 20 61 6e 64 20 66 69 6c created and fil
4c90: 6c 65 64 20 69 6e 20 69 6e 20 6d 61 6e 79 20 6f led in in many o
4ca0: 74 68 65 72 0a 3b 20 77 61 79 73 20 28 65 2e 67 ther.; ways (e.g
4cb0: 2e 2c 20 6c 6f 61 64 65 64 20 66 72 6f 6d 20 61 ., loaded from a
4cc0: 20 66 69 6c 65 29 2e 0a 3b 0a 3b 20 65 6c 65 6d file)..;.; elem
4cd0: 73 3a 20 61 6e 20 28 61 73 73 6f 63 29 20 6c 69 s: an (assoc) li
4ce0: 73 74 20 6f 66 20 64 65 63 6c 2d 65 6c 65 6d 20 st of decl-elem
4cf0: 6f 72 20 23 66 2e 20 54 68 65 20 6c 61 74 74 65 or #f. The latte
4d00: 72 20 69 6e 73 74 72 75 63 74 73 0a 3b 09 74 68 r instructs.;.th
4d10: 65 20 70 61 72 73 65 72 20 74 6f 20 64 6f 20 6e e parser to do n
4d20: 6f 20 76 61 6c 69 64 61 74 69 6f 6e 20 6f 66 20 o validation of
4d30: 65 6c 65 6d 65 6e 74 73 20 61 6e 64 20 61 74 74 elements and att
4d40: 72 69 62 75 74 65 73 2e 0a 3b 0a 3b 20 64 65 63 ributes..;.; dec
4d50: 6c 2d 65 6c 65 6d 3a 20 64 65 63 6c 61 72 61 74 l-elem: declarat
4d60: 69 6f 6e 20 6f 66 20 6f 6e 65 20 65 6c 65 6d 65 ion of one eleme
4d70: 6e 74 3a 0a 3b 09 28 65 6c 65 6d 2d 6e 61 6d 65 nt:.;.(elem-name
4d80: 20 65 6c 65 6d 2d 63 6f 6e 74 65 6e 74 20 64 65 elem-content de
4d90: 63 6c 2d 61 74 74 72 73 29 0a 3b 09 65 6c 65 6d cl-attrs).;.elem
4da0: 2d 6e 61 6d 65 20 69 73 20 61 6e 20 55 4e 52 45 -name is an UNRE
4db0: 53 2d 4e 41 4d 45 20 66 6f 72 20 74 68 65 20 65 S-NAME for the e
4dc0: 6c 65 6d 65 6e 74 2e 0a 3b 09 65 6c 65 6d 2d 63 lement..;.elem-c
4dd0: 6f 6e 74 65 6e 74 20 69 73 20 61 6e 20 45 4c 45 ontent is an ELE
4de0: 4d 2d 43 4f 4e 54 45 4e 54 2d 4d 4f 44 45 4c 2e M-CONTENT-MODEL.
4df0: 0a 3b 09 64 65 63 6c 2d 61 74 74 72 73 20 69 73 .;.decl-attrs is
4e00: 20 61 6e 20 41 54 54 4c 49 53 54 2c 20 6f 66 20 an ATTLIST, of
4e10: 28 41 54 54 52 2d 4e 41 4d 45 20 2e 20 56 41 4c (ATTR-NAME . VAL
4e20: 55 45 29 20 61 73 73 6f 63 69 61 74 69 6f 6e 73 UE) associations
4e30: 0a 3b 20 21 21 21 54 68 69 73 20 65 6c 65 6d 65 .; !!!This eleme
4e40: 6e 74 20 63 61 6e 20 64 65 63 6c 61 72 65 20 61 nt can declare a
4e50: 20 75 73 65 72 20 70 72 6f 63 65 64 75 72 65 20 user procedure
4e60: 74 6f 20 68 61 6e 64 6c 65 20 70 61 72 73 69 6e to handle parsin
4e70: 67 20 6f 66 20 61 6e 0a 3b 20 65 6c 65 6d 65 6e g of an.; elemen
4e80: 74 20 28 65 2e 67 2e 2c 20 74 6f 20 64 6f 20 61 t (e.g., to do a
4e90: 20 63 75 73 74 6f 6d 20 76 61 6c 69 64 61 74 69 custom validati
4ea0: 6f 6e 2c 20 6f 72 20 74 6f 20 62 75 69 6c 64 20 on, or to build
4eb0: 61 20 68 61 73 68 20 6f 66 0a 3b 20 49 44 73 20 a hash of.; IDs
4ec0: 61 73 20 74 68 65 79 27 72 65 20 65 6e 63 6f 75 as they're encou
4ed0: 6e 74 65 72 65 64 29 2e 0a 3b 0a 3b 20 64 65 63 ntered)..;.; dec
4ee0: 6c 2d 61 74 74 72 3a 20 61 6e 20 65 6c 65 6d 65 l-attr: an eleme
4ef0: 6e 74 20 6f 66 20 61 6e 20 41 54 54 4c 49 53 54 nt of an ATTLIST
4f00: 2c 20 64 65 63 6c 61 72 61 74 69 6f 6e 20 6f 66 , declaration of
4f10: 20 6f 6e 65 20 61 74 74 72 69 62 75 74 65 0a 3b one attribute.;
4f20: 09 28 61 74 74 72 2d 6e 61 6d 65 20 63 6f 6e 74 .(attr-name cont
4f30: 65 6e 74 2d 74 79 70 65 20 75 73 65 2d 74 79 70 ent-type use-typ
4f40: 65 20 64 65 66 61 75 6c 74 2d 76 61 6c 75 65 29 e default-value)
4f50: 0a 3b 09 61 74 74 72 2d 6e 61 6d 65 20 69 73 20 .;.attr-name is
4f60: 61 6e 20 55 4e 52 45 53 2d 4e 41 4d 45 20 66 6f an UNRES-NAME fo
4f70: 72 20 74 68 65 20 64 65 63 6c 61 72 65 64 20 61 r the declared a
4f80: 74 74 72 69 62 75 74 65 0a 3b 09 63 6f 6e 74 65 ttribute.;.conte
4f90: 6e 74 2d 74 79 70 65 20 69 73 20 61 20 73 79 6d nt-type is a sym
4fa0: 62 6f 6c 3a 20 43 44 41 54 41 2c 20 4e 4d 54 4f bol: CDATA, NMTO
4fb0: 4b 45 4e 2c 20 4e 4d 54 4f 4b 45 4e 53 2c 20 2e KEN, NMTOKENS, .
4fc0: 2e 2e 0a 3b 09 09 6f 72 20 61 20 6c 69 73 74 20 ...;..or a list
4fd0: 6f 66 20 73 74 72 69 6e 67 73 20 66 6f 72 20 74 of strings for t
4fe0: 68 65 20 65 6e 75 6d 65 72 61 74 65 64 20 74 79 he enumerated ty
4ff0: 70 65 2e 0a 3b 09 75 73 65 2d 74 79 70 65 20 69 pe..;.use-type i
5000: 73 20 61 20 73 79 6d 62 6f 6c 3a 20 52 45 51 55 s a symbol: REQU
5010: 49 52 45 44 2c 20 49 4d 50 4c 49 45 44 2c 20 46 IRED, IMPLIED, F
5020: 49 58 45 44 0a 3b 09 64 65 66 61 75 6c 74 2d 76 IXED.;.default-v
5030: 61 6c 75 65 20 69 73 20 61 20 73 74 72 69 6e 67 alue is a string
5040: 20 66 6f 72 20 74 68 65 20 64 65 66 61 75 6c 74 for the default
5050: 20 76 61 6c 75 65 2c 20 6f 72 20 23 66 20 69 66 value, or #f if
5060: 20 6e 6f 74 20 67 69 76 65 6e 2e 0a 3b 0a 3b 0a not given..;.;.
5070: 0a 3b 20 73 65 65 20 61 20 66 75 6e 63 74 69 6f .; see a functio
5080: 6e 20 6d 61 6b 65 2d 65 6d 70 74 79 2d 78 6d 6c n make-empty-xml
5090: 2d 64 65 63 6c 20 74 6f 20 6d 61 6b 65 20 61 20 -decl to make a
50a0: 58 4d 4c 20 64 65 63 6c 61 72 61 74 69 6f 6e 20 XML declaration
50b0: 65 6e 74 72 79 0a 3b 20 73 75 69 74 61 62 6c 65 entry.; suitable
50c0: 20 66 6f 72 20 61 20 6e 6f 6e 2d 76 61 6c 69 64 for a non-valid
50d0: 61 74 69 6e 67 20 70 61 72 73 69 6e 67 2e 0a 0a ating parsing...
50e0: 0a 3b 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d .;--------------
50f0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 20 55 74 -----------.; Ut
5100: 69 6c 69 74 69 65 73 0a 0a 3b 20 54 68 65 20 66 ilities..; The f
5110: 6f 6c 6c 6f 77 69 6e 67 20 69 73 20 61 20 66 75 ollowing is a fu
5120: 6e 63 74 69 6f 6e 20 74 68 61 74 20 69 73 20 6f nction that is o
5130: 66 74 65 6e 20 75 73 65 64 20 69 6e 20 76 61 6c ften used in val
5140: 69 64 61 74 69 6f 6e 20 74 65 73 74 73 2c 0a 3b idation tests,.;
5150: 20 74 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 68 to make sure th
5160: 61 74 20 74 68 65 20 63 6f 6d 70 75 74 65 64 20 at the computed
5170: 72 65 73 75 6c 74 20 6d 61 74 63 68 65 73 20 74 result matches t
5180: 68 65 20 65 78 70 65 63 74 65 64 20 6f 6e 65 2e he expected one.
5190: 0a 3b 20 54 68 69 73 20 66 75 6e 63 74 69 6f 6e .; This function
51a0: 20 69 73 20 61 20 73 74 61 6e 64 61 72 64 20 65 is a standard e
51b0: 71 75 61 6c 3f 20 70 72 65 64 69 63 61 74 65 20 qual? predicate
51c0: 77 69 74 68 20 6f 6e 65 20 65 78 63 65 70 74 69 with one excepti
51d0: 6f 6e 2e 0a 3b 20 4f 6e 20 53 63 68 65 6d 65 20 on..; On Scheme
51e0: 73 79 73 74 65 6d 73 20 77 68 65 72 65 20 28 73 systems where (s
51f0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 41 tring->symbol "A
5200: 22 29 20 61 6e 64 20 61 20 73 79 6d 62 6f 6c 20 ") and a symbol
5210: 41 0a 3b 20 61 72 65 20 74 68 65 20 73 61 6d 65 A.; are the same
5220: 2c 20 65 71 75 61 6c 5f 3f 20 69 73 20 70 72 65 , equal_? is pre
5230: 63 69 73 65 6c 79 20 65 71 75 61 6c 3f 0a 3b 20 cisely equal?.;
5240: 4f 6e 20 6f 74 68 65 72 20 53 63 68 65 6d 65 20 On other Scheme
5250: 73 79 73 74 65 6d 73 2c 20 77 65 20 63 6f 6d 70 systems, we comp
5260: 61 72 65 20 73 79 6d 62 6f 6c 73 20 64 69 73 72 are symbols disr
5270: 65 67 61 72 64 69 6e 67 20 74 68 65 69 72 20 63 egarding their c
5280: 61 73 65 2e 0a 3b 20 53 69 6e 63 65 20 74 68 69 ase..; Since thi
5290: 73 20 66 75 6e 63 74 69 6f 6e 20 69 73 20 75 73 s function is us
52a0: 65 64 20 6f 6e 6c 79 20 69 6e 20 74 65 73 74 73 ed only in tests
52b0: 2c 20 77 65 20 64 6f 6e 27 74 20 68 61 76 65 20 , we don't have
52c0: 74 6f 0a 3b 20 73 74 72 69 76 65 20 74 6f 20 6d to.; strive to m
52d0: 61 6b 65 20 69 74 20 65 66 66 69 63 69 65 6e 74 ake it efficient
52e0: 2e 0a 0a 20 28 64 65 66 69 6e 65 20 28 65 71 75 ... (define (equ
52f0: 61 6c 5f 3f 20 65 31 20 65 32 29 0a 20 20 20 28 al_? e1 e2). (
5300: 69 66 20 28 65 71 3f 20 27 41 20 28 73 74 72 69 if (eq? 'A (stri
5310: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 41 22 29 29 ng->symbol "A"))
5320: 20 28 65 71 75 61 6c 3f 20 65 31 20 65 32 29 0a (equal? e1 e2).
5330: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 09 28 28 (cond..((
5340: 73 79 6d 62 6f 6c 3f 20 65 31 29 0a 09 20 28 61 symbol? e1).. (a
5350: 6e 64 20 28 73 79 6d 62 6f 6c 3f 20 65 32 29 20 nd (symbol? e2)
5360: 0a 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d .. (string-
5370: 63 69 3d 3f 20 28 73 79 6d 62 6f 6c 2d 3e 73 74 ci=? (symbol->st
5380: 72 69 6e 67 20 65 31 29 20 28 73 79 6d 62 6f 6c ring e1) (symbol
5390: 2d 3e 73 74 72 69 6e 67 20 65 32 29 29 29 29 0a ->string e2)))).
53a0: 09 28 28 70 61 69 72 3f 20 65 31 29 0a 09 20 28 .((pair? e1).. (
53b0: 61 6e 64 20 28 70 61 69 72 3f 20 65 32 29 0a 09 and (pair? e2)..
53c0: 20 20 20 20 20 20 28 65 71 75 61 6c 5f 3f 20 28 (equal_? (
53d0: 63 61 72 20 65 31 29 20 28 63 61 72 20 65 32 29 car e1) (car e2)
53e0: 29 20 28 65 71 75 61 6c 5f 3f 20 28 63 64 72 20 ) (equal_? (cdr
53f0: 65 31 29 20 28 63 64 72 20 65 32 29 29 29 29 0a e1) (cdr e2)))).
5400: 09 28 28 76 65 63 74 6f 72 3f 20 65 31 29 0a 09 .((vector? e1)..
5410: 20 28 61 6e 64 20 28 76 65 63 74 6f 72 3f 20 65 (and (vector? e
5420: 32 29 20 28 65 71 75 61 6c 5f 3f 20 28 76 65 63 2) (equal_? (vec
5430: 74 6f 72 2d 3e 6c 69 73 74 20 65 31 29 20 28 76 tor->list e1) (v
5440: 65 63 74 6f 72 2d 3e 6c 69 73 74 20 65 32 29 29 ector->list e2))
5450: 29 29 0a 09 28 65 6c 73 65 0a 09 20 28 65 71 75 ))..(else.. (equ
5460: 61 6c 3f 20 65 31 20 65 32 29 29 29 29 29 0a 0a al? e1 e2)))))..
5470: 0a 3b 20 54 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 .; The following
5480: 20 66 75 6e 63 74 69 6f 6e 2c 20 77 68 69 63 68 function, which
5490: 20 69 73 20 6f 66 74 65 6e 20 75 73 65 64 20 69 is often used i
54a0: 6e 20 76 61 6c 69 64 61 74 69 6f 6e 20 74 65 73 n validation tes
54b0: 74 73 2c 0a 3b 20 6c 65 74 73 20 75 73 20 63 6f ts,.; lets us co
54c0: 6e 76 65 6e 69 65 6e 74 6c 79 20 65 6e 74 65 72 nveniently enter
54d0: 20 6e 65 77 6c 69 6e 65 2c 20 43 52 20 61 6e 64 newline, CR and
54e0: 20 74 61 62 20 63 68 61 72 61 63 74 65 72 73 20 tab characters
54f0: 69 6e 20 61 20 63 68 61 72 61 63 74 65 72 0a 3b in a character.;
5500: 20 73 74 72 69 6e 67 2e 0a 3b 09 75 6e 65 73 63 string..;.unesc
5510: 2d 73 74 72 69 6e 67 3a 20 45 53 43 2d 53 54 52 -string: ESC-STR
5520: 49 4e 47 20 2d 3e 20 53 54 52 49 4e 47 0a 3b 20 ING -> STRING.;
5530: 77 68 65 72 65 20 45 53 43 2d 53 54 52 49 4e 47 where ESC-STRING
5540: 20 69 73 20 61 20 63 68 61 72 61 63 74 65 72 20 is a character
5550: 73 74 72 69 6e 67 20 74 68 61 74 20 6d 61 79 20 string that may
5560: 63 6f 6e 74 61 69 6e 0a 3b 20 20 20 20 25 6e 20 contain.; %n
5570: 20 2d 2d 20 66 6f 72 20 23 5c 6e 65 77 6c 69 6e -- for #\newlin
5580: 65 0a 3b 20 20 20 20 25 72 20 20 2d 2d 20 66 6f e.; %r -- fo
5590: 72 20 23 5c 72 65 74 75 72 6e 0a 3b 20 20 20 20 r #\return.;
55a0: 25 74 20 20 2d 2d 20 66 6f 72 20 23 5c 74 61 62 %t -- for #\tab
55b0: 0a 3b 20 20 20 20 25 25 20 20 2d 2d 20 66 6f 72 .; %% -- for
55c0: 20 23 5c 25 0a 3b 0a 3b 20 54 68 65 20 72 65 73 #\%.;.; The res
55d0: 75 6c 74 20 6f 66 20 75 6e 65 73 63 2d 73 74 72 ult of unesc-str
55e0: 69 6e 67 20 69 73 20 61 20 63 68 61 72 61 63 74 ing is a charact
55f0: 65 72 20 73 74 72 69 6e 67 20 77 69 74 68 20 61 er string with a
5600: 6c 6c 20 25 2d 63 6f 6d 62 69 6e 61 74 69 6f 6e ll %-combination
5610: 73 0a 3b 20 61 62 6f 76 65 20 72 65 70 6c 61 63 s.; above replac
5620: 65 64 20 77 69 74 68 20 74 68 65 69 72 20 63 68 ed with their ch
5630: 61 72 61 63 74 65 72 20 65 71 75 69 76 61 6c 65 aracter equivale
5640: 6e 74 73 0a 0a 0a 20 28 64 65 66 69 6e 65 20 28 nts... (define (
5650: 75 6e 65 73 63 2d 73 74 72 69 6e 67 20 73 74 72 unesc-string str
5660: 29 0a 20 20 20 28 63 61 6c 6c 2d 77 69 74 68 2d ). (call-with-
5670: 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 73 74 72 input-string str
5680: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 . (lambda (p
5690: 6f 72 74 29 0a 20 20 20 20 20 20 20 28 6c 65 74 ort). (let
56a0: 20 6c 6f 6f 70 20 28 28 66 72 61 67 73 20 27 28 loop ((frags '(
56b0: 29 29 29 0a 09 20 28 6c 65 74 2a 20 28 28 74 6f ))).. (let* ((to
56c0: 6b 65 6e 20 28 6e 65 78 74 2d 74 6f 6b 65 6e 20 ken (next-token
56d0: 27 28 29 20 27 28 23 5c 25 20 2a 65 6f 66 2a 29 '() '(#\% *eof*)
56e0: 20 22 75 6e 65 73 63 2d 73 74 72 69 6e 67 22 20 "unesc-string"
56f0: 70 6f 72 74 29 29 0a 09 09 28 63 74 65 72 6d 20 port))...(cterm
5700: 28 72 65 61 64 2d 63 68 61 72 20 70 6f 72 74 29 (read-char port)
5710: 29 0a 09 09 28 66 72 61 67 73 20 28 63 6f 6e 73 )...(frags (cons
5720: 20 74 6f 6b 65 6e 20 66 72 61 67 73 29 29 29 0a token frags))).
5730: 09 20 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a . (if (eof-obj
5740: 65 63 74 3f 20 63 74 65 72 6d 29 20 28 73 74 72 ect? cterm) (str
5750: 69 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 65 2d ing-concatenate-
5760: 72 65 76 65 72 73 65 2f 73 68 61 72 65 64 20 66 reverse/shared f
5770: 72 61 67 73 29 0a 09 20 20 20 20 20 28 6c 65 74 rags).. (let
5780: 20 28 28 63 63 68 61 72 20 28 72 65 61 64 2d 63 ((cchar (read-c
5790: 68 61 72 20 70 6f 72 74 29 29 29 20 20 3b 20 63 har port))) ; c
57a0: 68 61 72 20 61 66 74 65 72 20 23 5c 25 0a 09 20 har after #\%..
57b0: 20 20 20 20 20 20 28 69 66 20 28 65 6f 66 2d 6f (if (eof-o
57c0: 62 6a 65 63 74 3f 20 63 63 68 61 72 29 0a 09 09 bject? cchar)...
57d0: 20 28 65 72 72 6f 72 20 22 75 6e 65 78 70 65 63 (error "unexpec
57e0: 74 65 64 20 45 4f 46 20 61 66 74 65 72 20 72 65 ted EOF after re
57f0: 61 64 69 6e 67 20 25 20 69 6e 20 75 6e 65 73 63 ading % in unesc
5800: 2d 73 74 72 69 6e 67 3a 22 20 73 74 72 29 0a 09 -string:" str)..
5810: 09 20 28 6c 6f 6f 70 0a 09 09 20 20 20 28 63 6f . (loop... (co
5820: 6e 73 0a 09 09 20 20 20 20 20 28 63 61 73 65 20 ns... (case
5830: 63 63 68 61 72 0a 09 09 20 20 20 20 20 20 20 28 cchar... (
5840: 28 23 5c 6e 29 20 28 73 74 72 69 6e 67 20 23 5c (#\n) (string #\
5850: 6e 65 77 6c 69 6e 65 29 29 0a 09 09 20 20 20 20 newline))...
5860: 20 20 20 28 28 23 5c 72 29 20 28 73 74 72 69 6e ((#\r) (strin
5870: 67 20 63 68 61 72 2d 72 65 74 75 72 6e 29 29 0a g char-return)).
5880: 09 09 20 20 20 20 20 20 20 28 28 23 5c 74 29 20 .. ((#\t)
5890: 28 73 74 72 69 6e 67 20 63 68 61 72 2d 74 61 62 (string char-tab
58a0: 29 29 0a 09 09 20 20 20 20 20 20 20 28 28 23 5c ))... ((#\
58b0: 25 29 20 22 25 22 29 0a 09 09 20 20 20 20 20 20 %) "%")...
58c0: 20 28 65 6c 73 65 20 28 65 72 72 6f 72 20 22 62 (else (error "b
58d0: 61 64 20 25 2d 63 68 61 72 20 69 6e 20 75 6e 65 ad %-char in une
58e0: 73 63 2d 73 74 72 69 6e 67 3a 22 20 63 63 68 61 sc-string:" ccha
58f0: 72 29 29 29 0a 09 09 20 20 20 20 20 66 72 61 67 r)))... frag
5900: 73 29 29 29 29 29 29 29 29 29 29 0a 0a 09 20 20 s))))))))))...
5910: 20 20 20 0a 0a 3b 20 54 65 73 74 20 69 66 20 61 ..; Test if a
5920: 20 73 74 72 69 6e 67 20 69 73 20 6d 61 64 65 20 string is made
5930: 6f 66 20 6f 6e 6c 79 20 77 68 69 74 65 73 70 61 of only whitespa
5940: 63 65 0a 3b 20 41 6e 20 65 6d 70 74 79 20 73 74 ce.; An empty st
5950: 72 69 6e 67 20 69 73 20 63 6f 6e 73 69 64 65 72 ring is consider
5960: 65 64 20 6d 61 64 65 20 6f 66 20 77 68 69 74 65 ed made of white
5970: 73 70 61 63 65 20 61 73 20 77 65 6c 6c 0a 28 64 space as well.(d
5980: 65 66 69 6e 65 20 28 73 74 72 69 6e 67 2d 77 68 efine (string-wh
5990: 69 74 65 73 70 61 63 65 3f 20 73 74 72 29 0a 20 itespace? str).
59a0: 20 28 6c 65 74 20 28 28 6c 65 6e 20 28 73 74 72 (let ((len (str
59b0: 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 ing-length str))
59c0: 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 ). (cond.
59d0: 20 28 28 7a 65 72 6f 3f 20 6c 65 6e 29 20 23 74 ((zero? len) #t
59e0: 29 0a 20 20 20 20 20 28 28 3d 20 31 20 6c 65 6e ). ((= 1 len
59f0: 29 20 28 63 68 61 72 2d 77 68 69 74 65 73 70 61 ) (char-whitespa
5a00: 63 65 3f 20 28 73 74 72 69 6e 67 2d 72 65 66 20 ce? (string-ref
5a10: 73 74 72 20 30 29 29 29 0a 20 20 20 20 20 28 28 str 0))). ((
5a20: 3d 20 32 20 6c 65 6e 29 20 28 61 6e 64 20 28 63 = 2 len) (and (c
5a30: 68 61 72 2d 77 68 69 74 65 73 70 61 63 65 3f 20 har-whitespace?
5a40: 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str
5a50: 30 29 29 0a 09 09 20 20 20 20 20 28 63 68 61 72 0))... (char
5a60: 2d 77 68 69 74 65 73 70 61 63 65 3f 20 28 73 74 -whitespace? (st
5a70: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 31 29 29 ring-ref str 1))
5a80: 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 )). (else.
5a90: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
5aa0: 69 20 30 29 29 0a 09 28 6f 72 20 28 3e 3d 20 69 i 0))..(or (>= i
5ab0: 20 6c 65 6e 29 0a 09 20 20 20 20 28 61 6e 64 20 len).. (and
5ac0: 28 63 68 61 72 2d 77 68 69 74 65 73 70 61 63 65 (char-whitespace
5ad0: 3f 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 ? (string-ref st
5ae0: 72 20 69 29 29 0a 09 09 20 28 6c 6f 6f 70 20 28 r i))... (loop (
5af0: 69 6e 63 20 69 29 29 29 29 29 29 29 29 29 0a 0a inc i)))))))))..
5b00: 3b 20 46 69 6e 64 20 76 61 6c 20 69 6e 20 61 6c ; Find val in al
5b10: 69 73 74 0a 3b 20 52 65 74 75 72 6e 20 28 76 61 ist.; Return (va
5b20: 6c 75 65 73 20 66 6f 75 6e 64 2d 65 6c 20 72 65 lues found-el re
5b30: 6d 61 69 6e 69 6e 67 2d 61 6c 69 73 74 29 20 6f maining-alist) o
5b40: 72 0a 3b 09 20 28 76 61 6c 75 65 73 20 23 66 20 r.;. (values #f
5b50: 61 6c 69 73 74 29 0a 0a 28 64 65 66 69 6e 65 20 alist)..(define
5b60: 28 61 73 73 71 2d 76 61 6c 75 65 73 20 76 61 6c (assq-values val
5b70: 20 61 6c 69 73 74 29 0a 20 20 28 6c 65 74 20 6c alist). (let l
5b80: 6f 6f 70 20 28 28 61 6c 69 73 74 20 61 6c 69 73 oop ((alist alis
5b90: 74 29 20 28 73 63 61 6e 6e 65 64 20 27 28 29 29 t) (scanned '())
5ba0: 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 ). (cond.
5bb0: 20 28 28 6e 75 6c 6c 3f 20 61 6c 69 73 74 29 20 ((null? alist)
5bc0: 28 76 61 6c 75 65 73 20 23 66 20 73 63 61 6e 6e (values #f scann
5bd0: 65 64 29 29 0a 20 20 20 20 20 28 28 65 71 75 61 ed)). ((equa
5be0: 6c 3f 20 76 61 6c 20 28 63 61 61 72 20 61 6c 69 l? val (caar ali
5bf0: 73 74 29 29 0a 20 20 20 20 20 20 28 76 61 6c 75 st)). (valu
5c00: 65 73 20 28 63 61 72 20 61 6c 69 73 74 29 20 28 es (car alist) (
5c10: 61 70 70 65 6e 64 20 73 63 61 6e 6e 65 64 20 28 append scanned (
5c20: 63 64 72 20 61 6c 69 73 74 29 29 29 29 0a 20 20 cdr alist)))).
5c30: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 28 (else. (
5c40: 6c 6f 6f 70 20 28 63 64 72 20 61 6c 69 73 74 29 loop (cdr alist)
5c50: 20 28 63 6f 6e 73 20 28 63 61 72 20 61 6c 69 73 (cons (car alis
5c60: 74 29 20 73 63 61 6e 6e 65 64 29 29 29 29 29 29 t) scanned))))))
5c70: 0a 0a 3b 20 46 72 6f 6d 20 53 52 46 49 2d 31 0a ..; From SRFI-1.
5c80: 28 64 65 66 69 6e 65 20 28 66 6f 6c 64 2d 72 69 (define (fold-ri
5c90: 67 68 74 20 6b 6f 6e 73 20 6b 6e 69 6c 20 6c 69 ght kons knil li
5ca0: 73 31 29 0a 20 20 20 20 28 6c 65 74 20 72 65 63 s1). (let rec
5cb0: 75 72 20 28 28 6c 69 73 20 6c 69 73 31 29 29 0a ur ((lis lis1)).
5cc0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
5cd0: 3f 20 6c 69 73 29 20 6b 6e 69 6c 0a 09 20 20 20 ? lis) knil..
5ce0: 20 28 6c 65 74 20 28 28 68 65 61 64 20 28 63 61 (let ((head (ca
5cf0: 72 20 6c 69 73 29 29 29 0a 09 20 20 20 20 20 20 r lis)))..
5d00: 28 6b 6f 6e 73 20 68 65 61 64 20 28 72 65 63 75 (kons head (recu
5d10: 72 20 28 63 64 72 20 6c 69 73 29 29 29 29 29 29 r (cdr lis))))))
5d20: 29 0a 0a 3b 20 4c 65 66 74 20 66 6f 6c 64 20 63 )..; Left fold c
5d30: 6f 6d 62 69 6e 61 74 6f 72 20 66 6f 72 20 61 20 ombinator for a
5d40: 73 69 6e 67 6c 65 20 6c 69 73 74 0a 28 64 65 66 single list.(def
5d50: 69 6e 65 20 28 66 6f 6c 64 20 6b 6f 6e 73 20 6b ine (fold kons k
5d60: 6e 69 6c 20 6c 69 73 31 29 0a 20 20 28 6c 65 74 nil lis1). (let
5d70: 20 6c 70 20 28 28 6c 69 73 20 6c 69 73 31 29 20 lp ((lis lis1)
5d80: 28 61 6e 73 20 6b 6e 69 6c 29 29 0a 20 20 20 20 (ans knil)).
5d90: 28 69 66 20 28 6e 75 6c 6c 3f 20 6c 69 73 29 20 (if (null? lis)
5da0: 61 6e 73 0a 20 20 20 20 20 20 28 6c 70 20 28 63 ans. (lp (c
5db0: 64 72 20 6c 69 73 29 20 28 6b 6f 6e 73 20 28 63 dr lis) (kons (c
5dc0: 61 72 20 6c 69 73 29 20 61 6e 73 29 29 29 29 29 ar lis) ans)))))
5dd0: 0a 0a 0a 0a 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ....;===========
5de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 09 =============.;.
5e20: 09 4c 6f 77 65 72 2d 6c 65 76 65 6c 20 70 61 72 .Lower-level par
5e30: 73 65 72 73 20 61 6e 64 20 73 63 61 6e 6e 65 72 sers and scanner
5e40: 73 0a 3b 0a 3b 20 54 68 65 79 20 64 65 61 6c 20 s.;.; They deal
5e50: 77 69 74 68 20 70 72 69 6d 69 74 69 76 65 20 6c with primitive l
5e60: 65 78 69 63 61 6c 20 75 6e 69 74 73 20 28 4e 61 exical units (Na
5e70: 6d 65 73 2c 20 77 68 69 74 65 73 70 61 63 65 73 mes, whitespaces
5e80: 2c 20 74 61 67 73 29 0a 3b 20 61 6e 64 20 77 69 , tags).; and wi
5e90: 74 68 20 70 69 65 63 65 73 20 6f 66 20 6d 6f 72 th pieces of mor
5ea0: 65 20 67 65 6e 65 72 69 63 20 70 72 6f 64 75 63 e generic produc
5eb0: 74 69 6f 6e 73 2e 20 4d 6f 73 74 20 6f 66 20 74 tions. Most of t
5ec0: 68 65 73 65 20 70 61 72 73 65 72 73 0a 3b 20 6d hese parsers.; m
5ed0: 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 69 6e ust be called in
5ee0: 20 61 70 70 72 6f 70 72 69 61 74 65 20 63 6f 6e appropriate con
5ef0: 74 65 78 74 2e 20 46 6f 72 20 65 78 61 6d 70 6c text. For exampl
5f00: 65 2c 20 73 73 61 78 3a 63 6f 6d 70 6c 65 74 65 e, ssax:complete
5f10: 2d 73 74 61 72 74 2d 74 61 67 0a 3b 20 6d 75 73 -start-tag.; mus
5f20: 74 20 62 65 20 63 61 6c 6c 65 64 20 6f 6e 6c 79 t be called only
5f30: 20 77 68 65 6e 20 74 68 65 20 73 74 61 72 74 2d when the start-
5f40: 74 61 67 20 68 61 73 20 62 65 65 6e 20 64 65 74 tag has been det
5f50: 65 63 74 65 64 20 61 6e 64 20 69 74 73 20 47 49 ected and its GI
5f60: 0a 3b 20 68 61 73 20 62 65 65 6e 20 72 65 61 64 .; has been read
5f70: 2e 0a 0a 3b 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ...;------------
5f80: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
5f90: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
5fa0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
5fb0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 3b 09 09 ------------.;..
5fc0: 09 4c 6f 77 2d 6c 65 76 65 6c 20 70 61 72 73 69 .Low-level parsi
5fd0: 6e 67 20 63 6f 64 65 0a 0a 3b 20 53 6b 69 70 20 ng code..; Skip
5fe0: 74 68 65 20 53 20 28 77 68 69 74 65 73 70 61 63 the S (whitespac
5ff0: 65 29 20 70 72 6f 64 75 63 74 69 6f 6e 20 61 73 e) production as
6000: 20 64 65 66 69 6e 65 64 20 62 79 0a 3b 20 5b 33 defined by.; [3
6010: 5d 20 53 20 3a 3a 3d 20 28 23 78 32 30 20 7c 20 ] S ::= (#x20 |
6020: 23 78 39 20 7c 20 23 78 44 20 7c 20 23 78 41 29 #x9 | #xD | #xA)
6030: 0a 3b 20 54 68 65 20 70 72 6f 63 65 64 75 72 65 .; The procedure
6040: 20 72 65 74 75 72 6e 73 20 74 68 65 20 66 69 72 returns the fir
6050: 73 74 20 6e 6f 74 2d 77 68 69 74 65 73 70 61 63 st not-whitespac
6060: 65 20 63 68 61 72 61 63 74 65 72 20 69 74 0a 3b e character it.;
6070: 20 65 6e 63 6f 75 6e 74 65 72 73 20 77 68 69 6c encounters whil
6080: 65 20 73 63 61 6e 6e 69 6e 67 20 74 68 65 20 50 e scanning the P
6090: 4f 52 54 2e 20 54 68 69 73 20 63 68 61 72 61 63 ORT. This charac
60a0: 74 65 72 20 69 73 20 6c 65 66 74 0a 3b 20 6f 6e ter is left.; on
60b0: 20 74 68 65 20 69 6e 70 75 74 20 73 74 72 65 61 the input strea
60c0: 6d 2e 0a 0a 28 64 65 66 69 6e 65 20 73 73 61 78 m...(define ssax
60d0: 3a 53 2d 63 68 61 72 73 20 28 6d 61 70 20 61 73 :S-chars (map as
60e0: 63 69 69 2d 3e 63 68 61 72 20 27 28 33 32 20 31 cii->char '(32 1
60f0: 30 20 39 20 31 33 29 29 29 0a 0a 28 64 65 66 69 0 9 13)))..(defi
6100: 6e 65 20 28 73 73 61 78 3a 73 6b 69 70 2d 53 20 ne (ssax:skip-S
6110: 70 6f 72 74 29 0a 20 20 28 73 6b 69 70 2d 77 68 port). (skip-wh
6120: 69 6c 65 20 73 73 61 78 3a 53 2d 63 68 61 72 73 ile ssax:S-chars
6130: 20 70 6f 72 74 29 29 0a 0a 0a 3b 20 52 65 61 64 port))...; Read
6140: 20 61 20 4e 61 6d 65 20 6c 65 78 65 6d 20 61 6e a Name lexem an
6150: 64 20 72 65 74 75 72 6e 20 69 74 20 61 73 20 73 d return it as s
6160: 74 72 69 6e 67 0a 3b 20 5b 34 5d 20 4e 61 6d 65 tring.; [4] Name
6170: 43 68 61 72 20 3a 3a 3d 20 4c 65 74 74 65 72 20 Char ::= Letter
6180: 7c 20 44 69 67 69 74 20 7c 20 27 2e 27 20 7c 20 | Digit | '.' |
6190: 27 2d 27 20 7c 20 27 5f 27 20 7c 20 27 3a 27 0a '-' | '_' | ':'.
61a0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
61b0: 20 20 20 7c 20 43 6f 6d 62 69 6e 69 6e 67 43 68 | CombiningCh
61c0: 61 72 20 7c 20 45 78 74 65 6e 64 65 72 0a 3b 20 ar | Extender.;
61d0: 5b 35 5d 20 4e 61 6d 65 20 3a 3a 3d 20 28 4c 65 [5] Name ::= (Le
61e0: 74 74 65 72 20 7c 20 27 5f 27 20 7c 20 27 3a 27 tter | '_' | ':'
61f0: 29 20 28 4e 61 6d 65 43 68 61 72 29 2a 0a 3b 0a ) (NameChar)*.;.
6200: 3b 20 54 68 69 73 20 63 6f 64 65 20 73 75 70 70 ; This code supp
6210: 6f 72 74 73 20 74 68 65 20 58 4d 4c 20 4e 61 6d orts the XML Nam
6220: 65 73 70 61 63 65 20 52 65 63 6f 6d 6d 65 6e 64 espace Recommend
6230: 61 74 69 6f 6e 20 52 45 43 2d 78 6d 6c 2d 6e 61 ation REC-xml-na
6240: 6d 65 73 2c 0a 3b 20 77 68 69 63 68 20 6d 6f 64 mes,.; which mod
6250: 69 66 69 65 73 20 74 68 65 20 61 62 6f 76 65 20 ifies the above
6260: 70 72 6f 64 75 63 74 69 6f 6e 73 20 61 73 20 66 productions as f
6270: 6f 6c 6c 6f 77 73 3a 0a 3b 0a 3b 20 5b 34 5d 20 ollows:.;.; [4]
6280: 4e 43 4e 61 6d 65 43 68 61 72 20 3a 3a 3d 20 4c NCNameChar ::= L
6290: 65 74 74 65 72 20 7c 20 44 69 67 69 74 20 7c 20 etter | Digit |
62a0: 27 2e 27 20 7c 20 27 2d 27 20 7c 20 27 5f 27 0a '.' | '-' | '_'.
62b0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
62c0: 20 20 20 20 20 20 20 20 7c 20 43 6f 6d 62 69 6e | Combin
62d0: 69 6e 67 43 68 61 72 20 7c 20 45 78 74 65 6e 64 ingChar | Extend
62e0: 65 72 0a 3b 20 5b 35 5d 20 4e 43 4e 61 6d 65 20 er.; [5] NCName
62f0: 3a 3a 3d 20 28 4c 65 74 74 65 72 20 7c 20 27 5f ::= (Letter | '_
6300: 27 29 20 28 4e 43 4e 61 6d 65 43 68 61 72 29 2a ') (NCNameChar)*
6310: 0a 3b 20 41 73 20 74 68 65 20 52 65 63 2d 78 6d .; As the Rec-xm
6320: 6c 2d 6e 61 6d 65 73 20 73 61 79 73 2c 0a 3b 20 l-names says,.;
6330: 22 41 6e 20 58 4d 4c 20 64 6f 63 75 6d 65 6e 74 "An XML document
6340: 20 63 6f 6e 66 6f 72 6d 73 20 74 6f 20 74 68 69 conforms to thi
6350: 73 20 73 70 65 63 69 66 69 63 61 74 69 6f 6e 20 s specification
6360: 69 66 20 61 6c 6c 20 6f 74 68 65 72 20 74 6f 6b if all other tok
6370: 65 6e 73 0a 3b 20 5b 6f 74 68 65 72 20 74 68 61 ens.; [other tha
6380: 6e 20 65 6c 65 6d 65 6e 74 20 74 79 70 65 73 20 n element types
6390: 61 6e 64 20 61 74 74 72 69 62 75 74 65 20 6e 61 and attribute na
63a0: 6d 65 73 5d 20 69 6e 20 74 68 65 20 64 6f 63 75 mes] in the docu
63b0: 6d 65 6e 74 20 77 68 69 63 68 0a 3b 20 61 72 65 ment which.; are
63c0: 20 72 65 71 75 69 72 65 64 2c 20 66 6f 72 20 58 required, for X
63d0: 4d 4c 20 63 6f 6e 66 6f 72 6d 61 6e 63 65 2c 20 ML conformance,
63e0: 74 6f 20 6d 61 74 63 68 20 74 68 65 20 58 4d 4c to match the XML
63f0: 20 70 72 6f 64 75 63 74 69 6f 6e 20 66 6f 72 0a production for.
6400: 3b 20 4e 61 6d 65 2c 20 6d 61 74 63 68 20 74 68 ; Name, match th
6410: 69 73 20 73 70 65 63 69 66 69 63 61 74 69 6f 6e is specification
6420: 27 73 20 70 72 6f 64 75 63 74 69 6f 6e 20 66 6f 's production fo
6430: 72 20 4e 43 4e 61 6d 65 2e 22 0a 3b 20 45 6c 65 r NCName.".; Ele
6440: 6d 65 6e 74 20 74 79 70 65 73 20 61 6e 64 20 61 ment types and a
6450: 74 74 72 69 62 75 74 65 20 6e 61 6d 65 73 20 6d ttribute names m
6460: 75 73 74 20 6d 61 74 63 68 20 74 68 65 20 70 72 ust match the pr
6470: 6f 64 75 63 74 69 6f 6e 20 51 4e 61 6d 65 2c 0a oduction QName,.
6480: 3b 20 64 65 66 69 6e 65 64 20 62 65 6c 6f 77 2e ; defined below.
6490: 0a 0a 3b 20 43 68 65 63 6b 20 74 6f 20 73 65 65 ..; Check to see
64a0: 20 69 66 20 61 2d 63 68 61 72 20 6d 61 79 20 73 if a-char may s
64b0: 74 61 72 74 20 61 20 4e 43 4e 61 6d 65 0a 28 64 tart a NCName.(d
64c0: 65 66 69 6e 65 20 28 73 73 61 78 3a 6e 63 6e 61 efine (ssax:ncna
64d0: 6d 65 2d 73 74 61 72 74 69 6e 67 2d 63 68 61 72 me-starting-char
64e0: 3f 20 61 2d 63 68 61 72 29 0a 20 20 28 61 6e 64 ? a-char). (and
64f0: 20 28 63 68 61 72 3f 20 61 2d 63 68 61 72 29 0a (char? a-char).
6500: 20 20 20 20 28 6f 72 0a 20 20 20 20 20 20 28 63 (or. (c
6510: 68 61 72 2d 61 6c 70 68 61 62 65 74 69 63 3f 20 har-alphabetic?
6520: 61 2d 63 68 61 72 29 0a 20 20 20 20 20 20 28 63 a-char). (c
6530: 68 61 72 3d 3f 20 23 5c 5f 20 61 2d 63 68 61 72 har=? #\_ a-char
6540: 29 29 29 29 0a 0a 0a 3b 20 52 65 61 64 20 61 20 ))))...; Read a
6550: 4e 43 4e 61 6d 65 20 73 74 61 72 74 69 6e 67 20 NCName starting
6560: 66 72 6f 6d 20 74 68 65 20 63 75 72 72 65 6e 74 from the current
6570: 20 70 6f 73 69 74 69 6f 6e 20 69 6e 20 74 68 65 position in the
6580: 20 50 4f 52 54 20 61 6e 64 0a 3b 20 72 65 74 75 PORT and.; retu
6590: 72 6e 20 69 74 20 61 73 20 61 20 73 79 6d 62 6f rn it as a symbo
65a0: 6c 2e 0a 28 64 65 66 69 6e 65 20 28 73 73 61 78 l..(define (ssax
65b0: 3a 72 65 61 64 2d 4e 43 4e 61 6d 65 20 70 6f 72 :read-NCName por
65c0: 74 29 0a 20 20 28 6c 65 74 20 28 28 66 69 72 73 t). (let ((firs
65d0: 74 2d 63 68 61 72 20 28 70 65 65 6b 2d 63 68 61 t-char (peek-cha
65e0: 72 20 70 6f 72 74 29 29 29 0a 20 20 20 20 28 6f r port))). (o
65f0: 72 20 28 73 73 61 78 3a 6e 63 6e 61 6d 65 2d 73 r (ssax:ncname-s
6600: 74 61 72 74 69 6e 67 2d 63 68 61 72 3f 20 66 69 tarting-char? fi
6610: 72 73 74 2d 63 68 61 72 29 0a 20 20 20 20 20 20 rst-char).
6620: 28 70 61 72 73 65 72 2d 65 72 72 6f 72 20 70 6f (parser-error po
6630: 72 74 20 22 58 4d 4c 4e 53 20 5b 34 5d 20 66 6f rt "XMLNS [4] fo
6640: 72 20 27 22 20 66 69 72 73 74 2d 63 68 61 72 20 r '" first-char
6650: 22 27 22 29 29 29 0a 20 20 28 73 74 72 69 6e 67 "'"))). (string
6660: 2d 3e 73 79 6d 62 6f 6c 0a 20 20 20 20 28 6e 65 ->symbol. (ne
6670: 78 74 2d 74 6f 6b 65 6e 2d 6f 66 0a 20 20 20 20 xt-token-of.
6680: 20 20 28 6c 61 6d 62 64 61 20 28 63 29 0a 20 20 (lambda (c).
6690: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
66a0: 20 20 20 20 20 20 28 28 65 6f 66 2d 6f 62 6a 65 ((eof-obje
66b0: 63 74 3f 20 63 29 20 23 66 29 0a 20 20 20 20 20 ct? c) #f).
66c0: 20 20 20 20 20 28 28 63 68 61 72 2d 61 6c 70 68 ((char-alph
66d0: 61 62 65 74 69 63 3f 20 63 29 20 63 29 0a 20 20 abetic? c) c).
66e0: 20 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 ((string
66f0: 2d 69 6e 64 65 78 20 22 30 31 32 33 34 35 36 37 -index "01234567
6700: 38 39 2e 2d 5f 22 20 63 29 20 63 29 0a 20 20 20 89.-_" c) c).
6710: 20 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 29 (else #f)
6720: 29 29 0a 20 20 20 20 20 20 70 6f 72 74 29 29 29 )). port)))
6730: 0a 0a 3b 20 52 65 61 64 20 61 20 28 6e 61 6d 65 ..; Read a (name
6740: 73 70 61 63 65 2d 29 20 51 75 61 6c 69 66 69 65 space-) Qualifie
6750: 64 20 4e 61 6d 65 2c 20 51 4e 61 6d 65 2c 20 66 d Name, QName, f
6760: 72 6f 6d 20 74 68 65 20 63 75 72 72 65 6e 74 0a rom the current.
6770: 3b 20 70 6f 73 69 74 69 6f 6e 20 69 6e 20 74 68 ; position in th
6780: 65 20 50 4f 52 54 2e 0a 3b 20 46 72 6f 6d 20 52 e PORT..; From R
6790: 45 43 2d 78 6d 6c 2d 6e 61 6d 65 73 3a 0a 3b 09 EC-xml-names:.;.
67a0: 5b 36 5d 20 51 4e 61 6d 65 20 3a 3a 3d 20 28 50 [6] QName ::= (P
67b0: 72 65 66 69 78 20 27 3a 27 29 3f 20 4c 6f 63 61 refix ':')? Loca
67c0: 6c 50 61 72 74 0a 3b 09 5b 37 5d 20 50 72 65 66 lPart.;.[7] Pref
67d0: 69 78 20 3a 3a 3d 20 4e 43 4e 61 6d 65 0a 3b 09 ix ::= NCName.;.
67e0: 5b 38 5d 20 4c 6f 63 61 6c 50 61 72 74 20 3a 3a [8] LocalPart ::
67f0: 3d 20 4e 43 4e 61 6d 65 0a 3b 20 52 65 74 75 72 = NCName.; Retur
6800: 6e 3a 20 61 6e 20 55 4e 52 45 53 2d 4e 41 4d 45 n: an UNRES-NAME
6810: 0a 28 64 65 66 69 6e 65 20 28 73 73 61 78 3a 72 .(define (ssax:r
6820: 65 61 64 2d 51 4e 61 6d 65 20 70 6f 72 74 29 0a ead-QName port).
6830: 20 20 28 6c 65 74 20 28 28 70 72 65 66 69 78 2d (let ((prefix-
6840: 6f 72 2d 6c 6f 63 61 6c 70 61 72 74 20 28 73 73 or-localpart (ss
6850: 61 78 3a 72 65 61 64 2d 4e 43 4e 61 6d 65 20 70 ax:read-NCName p
6860: 6f 72 74 29 29 29 0a 20 20 20 20 28 63 61 73 65 ort))). (case
6870: 20 28 70 65 65 6b 2d 63 68 61 72 20 70 6f 72 74 (peek-char port
6880: 29 0a 20 20 20 20 20 20 28 28 23 5c 3a 29 09 09 ). ((#\:)..
6890: 09 3b 20 70 72 65 66 69 78 20 77 61 73 20 67 69 .; prefix was gi
68a0: 76 65 6e 20 61 66 74 65 72 20 61 6c 6c 0a 20 20 ven after all.
68b0: 20 20 20 20 20 28 72 65 61 64 2d 63 68 61 72 20 (read-char
68c0: 70 6f 72 74 29 09 09 3b 20 63 6f 6e 73 75 6d 65 port)..; consume
68d0: 20 74 68 65 20 63 6f 6c 6f 6e 0a 20 20 20 20 20 the colon.
68e0: 20 20 28 63 6f 6e 73 20 70 72 65 66 69 78 2d 6f (cons prefix-o
68f0: 72 2d 6c 6f 63 61 6c 70 61 72 74 20 28 73 73 61 r-localpart (ssa
6900: 78 3a 72 65 61 64 2d 4e 43 4e 61 6d 65 20 70 6f x:read-NCName po
6910: 72 74 29 29 29 0a 20 20 20 20 20 20 28 65 6c 73 rt))). (els
6920: 65 20 70 72 65 66 69 78 2d 6f 72 2d 6c 6f 63 61 e prefix-or-loca
6930: 6c 70 61 72 74 29 20 3b 20 50 72 65 66 69 78 20 lpart) ; Prefix
6940: 77 61 73 20 6f 6d 69 74 74 65 64 0a 20 20 20 20 was omitted.
6950: 20 20 29 29 29 0a 0a 3b 20 54 68 65 20 70 72 65 )))..; The pre
6960: 66 69 78 20 6f 66 20 74 68 65 20 70 72 65 2d 64 fix of the pre-d
6970: 65 66 69 6e 65 64 20 58 4d 4c 20 6e 61 6d 65 73 efined XML names
6980: 70 61 63 65 0a 28 64 65 66 69 6e 65 20 73 73 61 pace.(define ssa
6990: 78 3a 50 72 65 66 69 78 2d 58 4d 4c 20 28 73 74 x:Prefix-XML (st
69a0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 78 6d ring->symbol "xm
69b0: 6c 22 29 29 0a 0a 0a 3b 20 43 6f 6d 70 61 72 65 l"))...; Compare
69c0: 20 6f 6e 65 20 52 45 53 2d 4e 41 4d 45 20 6f 72 one RES-NAME or
69d0: 20 61 6e 20 55 4e 52 45 53 2d 4e 41 4d 45 20 77 an UNRES-NAME w
69e0: 69 74 68 20 74 68 65 20 6f 74 68 65 72 2e 0a 3b ith the other..;
69f0: 20 52 65 74 75 72 6e 20 61 20 73 79 6d 62 6f 6c Return a symbol
6a00: 20 27 3c 2c 20 27 3e 2c 20 6f 72 20 27 3d 20 64 '<, '>, or '= d
6a10: 65 70 65 6e 64 69 6e 67 20 6f 6e 20 74 68 65 20 epending on the
6a20: 72 65 73 75 6c 74 20 6f 66 0a 3b 20 74 68 65 20 result of.; the
6a30: 63 6f 6d 70 61 72 69 73 6f 6e 2e 0a 3b 20 4e 61 comparison..; Na
6a40: 6d 65 73 20 77 69 74 68 6f 75 74 20 50 52 45 46 mes without PREF
6a50: 49 58 20 61 72 65 20 61 6c 77 61 79 73 20 73 6d IX are always sm
6a60: 61 6c 6c 65 72 20 74 68 61 6e 20 74 68 6f 73 65 aller than those
6a70: 20 77 69 74 68 20 74 68 65 20 50 52 45 46 49 58 with the PREFIX
6a80: 2e 0a 28 64 65 66 69 6e 65 20 6e 61 6d 65 2d 63 ..(define name-c
6a90: 6f 6d 70 61 72 65 0a 20 20 28 6c 65 74 72 65 63 ompare. (letrec
6aa0: 20 28 28 73 79 6d 62 6f 6c 2d 63 6f 6d 70 61 72 ((symbol-compar
6ab0: 65 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 e.. (lambda (
6ac0: 73 79 6d 62 31 20 73 79 6d 62 32 29 0a 09 20 20 symb1 symb2)..
6ad0: 20 20 20 20 28 63 6f 6e 64 20 0a 09 20 20 20 20 (cond ..
6ae0: 20 20 20 28 28 65 71 3f 20 73 79 6d 62 31 20 73 ((eq? symb1 s
6af0: 79 6d 62 32 29 20 27 3d 29 0a 09 20 20 20 20 20 ymb2) '=)..
6b00: 20 20 28 28 73 74 72 69 6e 67 3c 3f 20 28 73 79 ((string<? (sy
6b10: 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 73 79 6d mbol->string sym
6b20: 62 31 29 20 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 b1) (symbol->str
6b30: 69 6e 67 20 73 79 6d 62 32 29 29 0a 09 09 27 3c ing symb2))...'<
6b40: 29 0a 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 ).. (else
6b50: 27 3e 29 29 29 29 29 0a 20 20 20 20 28 6c 61 6d '>))))). (lam
6b60: 62 64 61 20 28 6e 61 6d 65 31 20 6e 61 6d 65 32 bda (name1 name2
6b70: 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 ). (cond.
6b80: 20 20 20 20 20 28 28 73 79 6d 62 6f 6c 3f 20 6e ((symbol? n
6b90: 61 6d 65 31 29 20 28 69 66 20 28 73 79 6d 62 6f ame1) (if (symbo
6ba0: 6c 3f 20 6e 61 6d 65 32 29 20 28 73 79 6d 62 6f l? name2) (symbo
6bb0: 6c 2d 63 6f 6d 70 61 72 65 20 6e 61 6d 65 31 20 l-compare name1
6bc0: 6e 61 6d 65 32 29 0a 09 09 09 20 20 20 20 27 3c name2).... '<
6bd0: 29 29 0a 20 20 20 20 20 20 20 28 28 73 79 6d 62 )). ((symb
6be0: 6f 6c 3f 20 6e 61 6d 65 32 29 20 27 3e 29 0a 20 ol? name2) '>).
6bf0: 20 20 20 20 20 20 28 28 65 71 3f 20 6e 61 6d 65 ((eq? name
6c00: 32 20 73 73 61 78 3a 6c 61 72 67 65 73 74 2d 75 2 ssax:largest-u
6c10: 6e 72 65 73 2d 6e 61 6d 65 29 20 27 3c 29 0a 20 nres-name) '<).
6c20: 20 20 20 20 20 20 28 28 65 71 3f 20 6e 61 6d 65 ((eq? name
6c30: 31 20 73 73 61 78 3a 6c 61 72 67 65 73 74 2d 75 1 ssax:largest-u
6c40: 6e 72 65 73 2d 6e 61 6d 65 29 20 27 3e 29 0a 20 nres-name) '>).
6c50: 20 20 20 20 20 20 28 28 65 71 3f 20 28 63 61 72 ((eq? (car
6c60: 20 6e 61 6d 65 31 29 20 28 63 61 72 20 6e 61 6d name1) (car nam
6c70: 65 32 29 29 09 3b 20 70 72 65 66 69 78 65 73 20 e2)).; prefixes
6c80: 74 68 65 20 73 61 6d 65 0a 09 28 73 79 6d 62 6f the same..(symbo
6c90: 6c 2d 63 6f 6d 70 61 72 65 20 28 63 64 72 20 6e l-compare (cdr n
6ca0: 61 6d 65 31 29 20 28 63 64 72 20 6e 61 6d 65 32 ame1) (cdr name2
6cb0: 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 ))). (else
6cc0: 20 28 73 79 6d 62 6f 6c 2d 63 6f 6d 70 61 72 65 (symbol-compare
6cd0: 20 28 63 61 72 20 6e 61 6d 65 31 29 20 28 63 61 (car name1) (ca
6ce0: 72 20 6e 61 6d 65 32 29 29 29 29 29 29 29 0a 0a r name2)))))))..
6cf0: 3b 20 41 6e 20 55 4e 52 45 53 2d 4e 41 4d 45 20 ; An UNRES-NAME
6d00: 74 68 61 74 20 69 73 20 70 6f 73 74 75 6c 61 74 that is postulat
6d10: 65 64 20 74 6f 20 62 65 20 6c 61 72 67 65 72 20 ed to be larger
6d20: 74 68 61 6e 20 61 6e 79 74 68 69 6e 67 20 74 68 than anything th
6d30: 61 74 20 63 61 6e 20 6f 63 63 75 72 20 69 6e 0a at can occur in.
6d40: 3b 20 61 20 77 65 6c 6c 2d 66 6f 72 6d 65 64 20 ; a well-formed
6d50: 58 4d 4c 20 64 6f 63 75 6d 65 6e 74 2e 0a 3b 20 XML document..;
6d60: 6e 61 6d 65 2d 63 6f 6d 70 61 72 65 20 65 6e 66 name-compare enf
6d70: 6f 72 63 65 73 20 74 68 69 73 20 70 6f 73 74 75 orces this postu
6d80: 6c 61 74 65 2e 0a 28 64 65 66 69 6e 65 20 73 73 late..(define ss
6d90: 61 78 3a 6c 61 72 67 65 73 74 2d 75 6e 72 65 73 ax:largest-unres
6da0: 2d 6e 61 6d 65 20 28 63 6f 6e 73 20 0a 09 09 09 -name (cons ....
6db0: 09 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 . (string->symb
6dc0: 6f 6c 20 22 23 4c 41 52 47 45 53 54 2d 53 59 4d ol "#LARGEST-SYM
6dd0: 42 4f 4c 22 29 0a 09 09 09 09 20 20 28 73 74 72 BOL")..... (str
6de0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 23 4c 41 ing->symbol "#LA
6df0: 52 47 45 53 54 2d 53 59 4d 42 4f 4c 22 29 29 29 RGEST-SYMBOL")))
6e00: 0a 0a 0a 3b 20 70 72 6f 63 65 64 75 72 65 3a 09 ...; procedure:.
6e10: 73 73 61 78 3a 72 65 61 64 2d 6d 61 72 6b 75 70 ssax:read-markup
6e20: 2d 74 6f 6b 65 6e 20 50 4f 52 54 0a 3b 20 54 68 -token PORT.; Th
6e30: 69 73 20 70 72 6f 63 65 64 75 72 65 20 73 74 61 is procedure sta
6e40: 72 74 73 20 70 61 72 73 69 6e 67 20 6f 66 20 61 rts parsing of a
6e50: 20 6d 61 72 6b 75 70 20 74 6f 6b 65 6e 2e 20 54 markup token. T
6e60: 68 65 20 63 75 72 72 65 6e 74 20 70 6f 73 69 74 he current posit
6e70: 69 6f 6e 0a 3b 20 69 6e 20 74 68 65 20 73 74 72 ion.; in the str
6e80: 65 61 6d 20 6d 75 73 74 20 62 65 20 23 5c 3c 2e eam must be #\<.
6e90: 20 54 68 69 73 20 70 72 6f 63 65 64 75 72 65 20 This procedure
6ea0: 73 63 61 6e 73 20 65 6e 6f 75 67 68 20 6f 66 20 scans enough of
6eb0: 74 68 65 20 69 6e 70 75 74 20 73 74 72 65 61 6d the input stream
6ec0: 0a 3b 20 74 6f 20 66 69 67 75 72 65 20 6f 75 74 .; to figure out
6ed0: 20 77 68 61 74 20 6b 69 6e 64 20 6f 66 20 61 20 what kind of a
6ee0: 6d 61 72 6b 75 70 20 74 6f 6b 65 6e 20 69 74 20 markup token it
6ef0: 69 73 20 73 65 65 69 6e 67 2e 20 54 68 65 20 70 is seeing. The p
6f00: 72 6f 63 65 64 75 72 65 20 72 65 74 75 72 6e 73 rocedure returns
6f10: 0a 3b 20 61 6e 20 78 6d 6c 2d 74 6f 6b 65 6e 20 .; an xml-token
6f20: 73 74 72 75 63 74 75 72 65 20 64 65 73 63 72 69 structure descri
6f30: 62 69 6e 67 20 74 68 65 20 74 6f 6b 65 6e 2e 20 bing the token.
6f40: 4e 6f 74 65 2c 20 67 65 6e 65 72 61 6c 6c 79 20 Note, generally
6f50: 72 65 61 64 69 6e 67 0a 3b 20 6f 66 20 74 68 65 reading.; of the
6f60: 20 63 75 72 72 65 6e 74 20 6d 61 72 6b 75 70 20 current markup
6f70: 69 73 20 6e 6f 74 20 66 69 6e 69 73 68 65 64 21 is not finished!
6f80: 20 49 6e 20 70 61 72 74 69 63 75 6c 61 72 2c 20 In particular,
6f90: 6e 6f 20 61 74 74 72 69 62 75 74 65 73 20 6f 66 no attributes of
6fa0: 0a 3b 20 74 68 65 20 73 74 61 72 74 2d 74 61 67 .; the start-tag
6fb0: 20 74 6f 6b 65 6e 20 61 72 65 20 73 63 61 6e 6e token are scann
6fc0: 65 64 2e 0a 3b 0a 3b 20 48 65 72 65 27 73 20 61 ed..;.; Here's a
6fd0: 20 64 65 74 61 69 6c 65 64 20 62 72 65 61 6b 20 detailed break
6fe0: 6f 75 74 20 6f 66 20 74 68 65 20 72 65 74 75 72 out of the retur
6ff0: 6e 20 76 61 6c 75 65 73 20 61 6e 64 20 74 68 65 n values and the
7000: 20 70 6f 73 69 74 69 6f 6e 20 69 6e 20 74 68 65 position in the
7010: 20 50 4f 52 54 0a 3b 20 77 68 65 6e 20 74 68 61 PORT.; when tha
7020: 74 20 70 61 72 74 69 63 75 6c 61 72 20 76 61 6c t particular val
7030: 75 65 20 69 73 20 72 65 74 75 72 6e 65 64 3a 0a ue is returned:.
7040: 3b 09 50 49 2d 74 6f 6b 65 6e 3a 09 6f 6e 6c 79 ;.PI-token:.only
7050: 20 50 49 2d 74 61 72 67 65 74 20 69 73 20 72 65 PI-target is re
7060: 61 64 2e 0a 3b 09 09 09 54 6f 20 66 69 6e 69 73 ad..;...To finis
7070: 68 20 74 68 65 20 50 72 6f 63 65 73 73 69 6e 67 h the Processing
7080: 20 49 6e 73 74 72 75 63 74 69 6f 6e 20 61 6e 64 Instruction and
7090: 20 64 69 73 72 65 67 61 72 64 20 69 74 2c 0a 3b disregard it,.;
70a0: 09 09 09 63 61 6c 6c 20 73 73 61 78 3a 73 6b 69 ...call ssax:ski
70b0: 70 2d 70 69 2e 20 73 73 61 78 3a 72 65 61 64 2d p-pi. ssax:read-
70c0: 61 74 74 72 69 62 75 74 65 73 20 6d 61 79 20 62 attributes may b
70d0: 65 20 75 73 65 66 75 6c 0a 3b 09 09 09 61 73 20 e useful.;...as
70e0: 77 65 6c 6c 20 28 66 6f 72 20 50 49 73 20 77 68 well (for PIs wh
70f0: 6f 73 65 20 63 6f 6e 74 65 6e 74 20 69 73 20 61 ose content is a
7100: 74 74 72 69 62 75 74 65 2d 76 61 6c 75 65 0a 3b ttribute-value.;
7110: 09 09 09 70 61 69 72 73 29 0a 3b 09 45 4e 44 2d ...pairs).;.END-
7120: 74 6f 6b 65 6e 3a 09 54 68 65 20 65 6e 64 20 74 token:.The end t
7130: 61 67 20 69 73 20 72 65 61 64 20 63 6f 6d 70 6c ag is read compl
7140: 65 74 65 6c 79 3b 20 74 68 65 20 63 75 72 72 65 etely; the curre
7150: 6e 74 20 70 6f 73 69 74 69 6f 6e 0a 3b 09 09 09 nt position.;...
7160: 69 73 20 72 69 67 68 74 20 61 66 74 65 72 20 74 is right after t
7170: 68 65 20 74 65 72 6d 69 6e 61 74 69 6e 67 20 23 he terminating #
7180: 5c 3e 20 63 68 61 72 61 63 74 65 72 2e 09 0a 3b \> character...;
7190: 09 43 4f 4d 4d 45 4e 54 09 09 69 73 20 72 65 61 .COMMENT..is rea
71a0: 64 20 61 6e 64 20 73 6b 69 70 70 65 64 20 63 6f d and skipped co
71b0: 6d 70 6c 65 74 65 6c 79 2e 20 54 68 65 20 63 75 mpletely. The cu
71c0: 72 72 65 6e 74 20 70 6f 73 69 74 69 6f 6e 0a 3b rrent position.;
71d0: 09 09 09 69 73 20 72 69 67 68 74 20 61 66 74 65 ...is right afte
71e0: 72 20 22 2d 2d 3e 22 20 74 68 61 74 20 74 65 72 r "-->" that ter
71f0: 6d 69 6e 61 74 65 73 20 74 68 65 20 63 6f 6d 6d minates the comm
7200: 65 6e 74 2e 0a 3b 09 43 44 53 45 43 54 09 09 54 ent..;.CDSECT..T
7210: 68 65 20 63 75 72 72 65 6e 74 20 70 6f 73 69 74 he current posit
7220: 69 6f 6e 20 69 73 20 72 69 67 68 74 20 61 66 74 ion is right aft
7230: 65 72 20 22 3c 21 43 44 41 54 41 5b 22 0a 3b 09 er "<!CDATA[".;.
7240: 09 09 55 73 65 20 73 73 61 78 3a 72 65 61 64 2d ..Use ssax:read-
7250: 63 64 61 74 61 2d 62 6f 64 79 20 74 6f 20 72 65 cdata-body to re
7260: 61 64 20 74 68 65 20 72 65 73 74 2e 0a 3b 09 44 ad the rest..;.D
7270: 45 43 4c 09 09 57 65 20 68 61 76 65 20 72 65 61 ECL..We have rea
7280: 64 20 74 68 65 20 6b 65 79 77 6f 72 64 20 28 74 d the keyword (t
7290: 68 65 20 6f 6e 65 20 74 68 61 74 20 66 6f 6c 6c he one that foll
72a0: 6f 77 73 20 22 3c 21 22 29 0a 3b 09 09 09 69 64 ows "<!").;...id
72b0: 65 6e 74 69 66 79 69 6e 67 20 74 68 69 73 20 64 entifying this d
72c0: 65 63 6c 61 72 61 74 69 6f 6e 20 6d 61 72 6b 75 eclaration marku
72d0: 70 2e 20 54 68 65 20 63 75 72 72 65 6e 74 0a 3b p. The current.;
72e0: 09 09 09 70 6f 73 69 74 69 6f 6e 20 69 73 20 61 ...position is a
72f0: 66 74 65 72 20 74 68 65 20 6b 65 79 77 6f 72 64 fter the keyword
7300: 20 28 75 73 75 61 6c 6c 79 20 61 0a 3b 09 09 09 (usually a.;...
7310: 77 68 69 74 65 73 70 61 63 65 20 63 68 61 72 61 whitespace chara
7320: 63 74 65 72 29 0a 3b 0a 3b 09 53 54 41 52 54 2d cter).;.;.START-
7330: 74 6f 6b 65 6e 09 57 65 20 68 61 76 65 20 72 65 token.We have re
7340: 61 64 20 74 68 65 20 6b 65 79 77 6f 72 64 20 28 ad the keyword (
7350: 47 49 29 20 6f 66 20 74 68 69 73 20 73 74 61 72 GI) of this star
7360: 74 20 74 61 67 2e 0a 3b 09 09 09 4e 6f 20 61 74 t tag..;...No at
7370: 74 72 69 62 75 74 65 73 20 61 72 65 20 73 63 61 tributes are sca
7380: 6e 6e 65 64 20 79 65 74 2e 20 57 65 20 64 6f 6e nned yet. We don
7390: 27 74 20 6b 6e 6f 77 20 69 66 20 74 68 69 73 0a 't know if this.
73a0: 3b 09 09 09 74 61 67 20 68 61 73 20 61 6e 20 65 ;...tag has an e
73b0: 6d 70 74 79 20 63 6f 6e 74 65 6e 74 20 65 69 74 mpty content eit
73c0: 68 65 72 2e 0a 3b 09 09 09 55 73 65 20 73 73 61 her..;...Use ssa
73d0: 78 3a 63 6f 6d 70 6c 65 74 65 2d 73 74 61 72 74 x:complete-start
73e0: 2d 74 61 67 20 74 6f 20 66 69 6e 69 73 68 20 70 -tag to finish p
73f0: 61 72 73 69 6e 67 20 6f 66 0a 3b 09 09 09 74 68 arsing of.;...th
7400: 65 20 74 6f 6b 65 6e 2e 0a 0a 28 64 65 66 69 6e e token...(defin
7410: 65 20 73 73 61 78 3a 72 65 61 64 2d 6d 61 72 6b e ssax:read-mark
7420: 75 70 2d 74 6f 6b 65 6e 20 3b 20 70 72 6f 63 65 up-token ; proce
7430: 64 75 72 65 20 73 73 61 78 3a 72 65 61 64 2d 6d dure ssax:read-m
7440: 61 72 6b 75 70 2d 74 6f 6b 65 6e 20 70 6f 72 74 arkup-token port
7450: 0a 20 28 6c 65 74 20 28 29 0a 20 20 09 09 3b 20 . (let (). ..;
7460: 77 65 20 68 61 76 65 20 72 65 61 64 20 22 3c 21 we have read "<!
7470: 2d 22 2e 20 53 6b 69 70 20 74 68 72 6f 75 67 68 -". Skip through
7480: 20 74 68 65 20 72 65 73 74 20 6f 66 20 74 68 65 the rest of the
7490: 20 63 6f 6d 6d 65 6e 74 0a 09 09 3b 20 52 65 74 comment...; Ret
74a0: 75 72 6e 20 74 68 65 20 27 43 4f 4d 4d 45 4e 54 urn the 'COMMENT
74b0: 20 74 6f 6b 65 6e 20 61 73 20 61 6e 20 69 6e 64 token as an ind
74c0: 69 63 61 74 69 6f 6e 20 77 65 20 73 61 77 20 61 ication we saw a
74d0: 20 63 6f 6d 6d 65 6e 74 0a 09 09 3b 20 61 6e 64 comment...; and
74e0: 20 73 6b 69 70 70 65 64 20 69 74 2e 0a 20 20 28 skipped it.. (
74f0: 64 65 66 69 6e 65 20 28 73 6b 69 70 2d 63 6f 6d define (skip-com
7500: 6d 65 6e 74 20 70 6f 72 74 29 0a 20 20 20 20 28 ment port). (
7510: 61 73 73 65 72 74 2d 63 75 72 72 2d 63 68 61 72 assert-curr-char
7520: 20 27 28 23 5c 2d 29 20 22 58 4d 4c 20 5b 31 35 '(#\-) "XML [15
7530: 5d 2c 20 73 65 63 6f 6e 64 20 64 61 73 68 22 20 ], second dash"
7540: 70 6f 72 74 29 0a 20 20 20 20 28 69 66 20 28 6e port). (if (n
7550: 6f 74 20 28 66 69 6e 64 2d 73 74 72 69 6e 67 2d ot (find-string-
7560: 66 72 6f 6d 2d 70 6f 72 74 3f 20 22 2d 2d 3e 22 from-port? "-->"
7570: 20 70 6f 72 74 29 29 0a 20 20 20 20 20 20 28 70 port)). (p
7580: 61 72 73 65 72 2d 65 72 72 6f 72 20 70 6f 72 74 arser-error port
7590: 20 22 58 4d 4c 20 5b 31 35 5d 2c 20 6e 6f 20 2d "XML [15], no -
75a0: 2d 3e 22 29 29 0a 20 20 20 20 28 6d 61 6b 65 2d ->")). (make-
75b0: 78 6d 6c 2d 74 6f 6b 65 6e 20 27 43 4f 4d 4d 45 xml-token 'COMME
75c0: 4e 54 20 23 66 29 29 0a 0a 20 20 09 09 3b 20 77 NT #f)).. ..; w
75d0: 65 20 68 61 76 65 20 72 65 61 64 20 22 3c 21 5b e have read "<![
75e0: 22 20 74 68 61 74 20 6d 75 73 74 20 62 65 67 69 " that must begi
75f0: 6e 20 61 20 43 44 41 54 41 20 73 65 63 74 69 6f n a CDATA sectio
7600: 6e 0a 20 20 28 64 65 66 69 6e 65 20 28 72 65 61 n. (define (rea
7610: 64 2d 63 64 61 74 61 20 70 6f 72 74 29 0a 20 20 d-cdata port).
7620: 20 20 28 61 73 73 65 72 74 20 28 73 74 72 69 6e (assert (strin
7630: 67 3d 3f 20 22 43 44 41 54 41 5b 22 20 28 72 65 g=? "CDATA[" (re
7640: 61 64 2d 73 74 72 69 6e 67 20 36 20 70 6f 72 74 ad-string 6 port
7650: 29 29 29 0a 20 20 20 20 28 6d 61 6b 65 2d 78 6d ))). (make-xm
7660: 6c 2d 74 6f 6b 65 6e 20 27 43 44 53 45 43 54 20 l-token 'CDSECT
7670: 23 66 29 29 0a 0a 20 20 28 6c 61 6d 62 64 61 20 #f)).. (lambda
7680: 28 70 6f 72 74 29 0a 20 20 20 20 28 61 73 73 65 (port). (asse
7690: 72 74 2d 63 75 72 72 2d 63 68 61 72 20 27 28 23 rt-curr-char '(#
76a0: 5c 3c 29 20 22 73 74 61 72 74 20 6f 66 20 74 68 \<) "start of th
76b0: 65 20 74 6f 6b 65 6e 22 20 70 6f 72 74 29 0a 20 e token" port).
76c0: 20 20 20 28 63 61 73 65 20 28 70 65 65 6b 2d 63 (case (peek-c
76d0: 68 61 72 20 70 6f 72 74 29 0a 20 20 20 20 20 20 har port).
76e0: 28 28 23 5c 2f 29 20 28 72 65 61 64 2d 63 68 61 ((#\/) (read-cha
76f0: 72 20 70 6f 72 74 29 0a 20 20 20 20 20 20 20 28 r port). (
7700: 62 65 67 69 6e 30 20 28 6d 61 6b 65 2d 78 6d 6c begin0 (make-xml
7710: 2d 74 6f 6b 65 6e 20 27 45 4e 44 20 28 73 73 61 -token 'END (ssa
7720: 78 3a 72 65 61 64 2d 51 4e 61 6d 65 20 70 6f 72 x:read-QName por
7730: 74 29 29 0a 09 20 20 20 20 20 20 20 28 73 73 61 t)).. (ssa
7740: 78 3a 73 6b 69 70 2d 53 20 70 6f 72 74 29 0a 09 x:skip-S port)..
7750: 20 20 20 20 20 20 20 28 61 73 73 65 72 74 2d 63 (assert-c
7760: 75 72 72 2d 63 68 61 72 20 27 28 23 5c 3e 29 20 urr-char '(#\>)
7770: 22 58 4d 4c 20 5b 34 32 5d 22 20 70 6f 72 74 29 "XML [42]" port)
7780: 29 29 0a 20 20 20 20 20 20 28 28 23 5c 3f 29 20 )). ((#\?)
7790: 28 72 65 61 64 2d 63 68 61 72 20 70 6f 72 74 29 (read-char port)
77a0: 20 28 6d 61 6b 65 2d 78 6d 6c 2d 74 6f 6b 65 6e (make-xml-token
77b0: 20 27 50 49 20 28 73 73 61 78 3a 72 65 61 64 2d 'PI (ssax:read-
77c0: 4e 43 4e 61 6d 65 20 70 6f 72 74 29 29 29 0a 20 NCName port))).
77d0: 20 20 20 20 20 28 28 23 5c 21 29 0a 20 20 20 20 ((#\!).
77e0: 20 20 20 28 63 61 73 65 20 28 70 65 65 6b 2d 6e (case (peek-n
77f0: 65 78 74 2d 63 68 61 72 20 70 6f 72 74 29 0a 09 ext-char port)..
7800: 20 28 28 23 5c 2d 29 20 28 72 65 61 64 2d 63 68 ((#\-) (read-ch
7810: 61 72 20 70 6f 72 74 29 20 28 73 6b 69 70 2d 63 ar port) (skip-c
7820: 6f 6d 6d 65 6e 74 20 70 6f 72 74 29 29 0a 09 20 omment port))..
7830: 28 28 23 5c 5b 29 20 28 72 65 61 64 2d 63 68 61 ((#\[) (read-cha
7840: 72 20 70 6f 72 74 29 20 28 72 65 61 64 2d 63 64 r port) (read-cd
7850: 61 74 61 20 70 6f 72 74 29 29 0a 09 20 28 65 6c ata port)).. (el
7860: 73 65 20 28 6d 61 6b 65 2d 78 6d 6c 2d 74 6f 6b se (make-xml-tok
7870: 65 6e 20 27 44 45 43 4c 20 28 73 73 61 78 3a 72 en 'DECL (ssax:r
7880: 65 61 64 2d 4e 43 4e 61 6d 65 20 70 6f 72 74 29 ead-NCName port)
7890: 29 29 29 29 0a 20 20 20 20 20 20 28 65 6c 73 65 )))). (else
78a0: 20 28 6d 61 6b 65 2d 78 6d 6c 2d 74 6f 6b 65 6e (make-xml-token
78b0: 20 27 53 54 41 52 54 20 28 73 73 61 78 3a 72 65 'START (ssax:re
78c0: 61 64 2d 51 4e 61 6d 65 20 70 6f 72 74 29 29 29 ad-QName port)))
78d0: 29 29 0a 29 29 0a 0a 0a 3b 20 54 68 65 20 63 75 )).))...; The cu
78e0: 72 72 65 6e 74 20 70 6f 73 69 74 69 6f 6e 20 69 rrent position i
78f0: 73 20 69 6e 73 69 64 65 20 61 20 50 49 2e 20 53 s inside a PI. S
7900: 6b 69 70 20 74 69 6c 6c 20 74 68 65 20 72 65 73 kip till the res
7910: 74 20 6f 66 20 74 68 65 20 50 49 0a 28 64 65 66 t of the PI.(def
7920: 69 6e 65 20 28 73 73 61 78 3a 73 6b 69 70 2d 70 ine (ssax:skip-p
7930: 69 20 70 6f 72 74 29 20 20 20 20 20 20 0a 20 20 i port) .
7940: 28 69 66 20 28 6e 6f 74 20 28 66 69 6e 64 2d 73 (if (not (find-s
7950: 74 72 69 6e 67 2d 66 72 6f 6d 2d 70 6f 72 74 3f tring-from-port?
7960: 20 22 3f 3e 22 20 70 6f 72 74 29 29 0a 20 20 20 "?>" port)).
7970: 20 28 70 61 72 73 65 72 2d 65 72 72 6f 72 20 70 (parser-error p
7980: 6f 72 74 20 22 46 61 69 6c 65 64 20 74 6f 20 66 ort "Failed to f
7990: 69 6e 64 20 3f 3e 20 74 65 72 6d 69 6e 61 74 69 ind ?> terminati
79a0: 6e 67 20 74 68 65 20 50 49 22 29 29 29 0a 0a 0a ng the PI")))...
79b0: 3b 20 54 68 65 20 63 75 72 72 65 6e 74 20 70 6f ; The current po
79c0: 73 69 74 69 6f 6e 20 69 73 20 72 69 67 68 74 20 sition is right
79d0: 61 66 74 65 72 20 72 65 61 64 69 6e 67 20 74 68 after reading th
79e0: 65 20 50 49 54 61 72 67 65 74 2e 20 57 65 20 72 e PITarget. We r
79f0: 65 61 64 20 74 68 65 0a 3b 20 62 6f 64 79 20 6f ead the.; body o
7a00: 66 20 50 49 20 61 6e 64 20 72 65 74 75 72 6e 20 f PI and return
7a10: 69 73 20 61 73 20 61 20 73 74 72 69 6e 67 2e 20 is as a string.
7a20: 54 68 65 20 70 6f 72 74 20 77 69 6c 6c 20 70 6f The port will po
7a30: 69 6e 74 20 74 6f 20 74 68 65 0a 3b 20 63 68 61 int to the.; cha
7a40: 72 61 63 74 65 72 20 72 69 67 68 74 20 61 66 74 racter right aft
7a50: 65 72 20 27 3f 3e 27 20 63 6f 6d 62 69 6e 61 74 er '?>' combinat
7a60: 69 6f 6e 20 74 68 61 74 20 74 65 72 6d 69 6e 61 ion that termina
7a70: 74 65 73 20 50 49 2e 0a 3b 20 5b 31 36 5d 20 50 tes PI..; [16] P
7a80: 49 20 3a 3a 3d 20 27 3c 3f 27 20 50 49 54 61 72 I ::= '<?' PITar
7a90: 67 65 74 20 28 53 20 28 43 68 61 72 2a 20 2d 20 get (S (Char* -
7aa0: 28 43 68 61 72 2a 20 27 3f 3e 27 20 43 68 61 72 (Char* '?>' Char
7ab0: 2a 29 29 29 3f 20 27 3f 3e 27 0a 0a 28 64 65 66 *)))? '?>'..(def
7ac0: 69 6e 65 20 28 73 73 61 78 3a 72 65 61 64 2d 70 ine (ssax:read-p
7ad0: 69 2d 62 6f 64 79 2d 61 73 2d 73 74 72 69 6e 67 i-body-as-string
7ae0: 20 70 6f 72 74 29 0a 20 20 28 73 73 61 78 3a 73 port). (ssax:s
7af0: 6b 69 70 2d 53 20 70 6f 72 74 29 09 09 3b 20 73 kip-S port)..; s
7b00: 6b 69 70 20 57 53 20 61 66 74 65 72 20 74 68 65 kip WS after the
7b10: 20 50 49 20 74 61 72 67 65 74 20 6e 61 6d 65 0a PI target name.
7b20: 20 20 28 73 74 72 69 6e 67 2d 63 6f 6e 63 61 74 (string-concat
7b30: 65 6e 61 74 65 2f 73 68 61 72 65 64 0a 20 20 20 enate/shared.
7b40: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 29 0a 20 20 (let loop ().
7b50: 20 20 20 20 28 6c 65 74 20 28 28 70 69 2d 66 72 (let ((pi-fr
7b60: 61 67 6d 65 6e 74 0a 09 20 20 20 20 20 28 6e 65 agment.. (ne
7b70: 78 74 2d 74 6f 6b 65 6e 20 27 28 29 20 27 28 23 xt-token '() '(#
7b80: 5c 3f 29 20 22 72 65 61 64 69 6e 67 20 50 49 20 \?) "reading PI
7b90: 63 6f 6e 74 65 6e 74 22 20 70 6f 72 74 29 29 29 content" port)))
7ba0: 0a 09 28 69 66 20 28 65 71 76 3f 20 23 5c 3e 20 ..(if (eqv? #\>
7bb0: 28 70 65 65 6b 2d 6e 65 78 74 2d 63 68 61 72 20 (peek-next-char
7bc0: 70 6f 72 74 29 29 0a 09 20 20 20 20 28 62 65 67 port)).. (beg
7bd0: 69 6e 0a 09 20 20 20 20 20 20 28 72 65 61 64 2d in.. (read-
7be0: 63 68 61 72 20 70 6f 72 74 29 0a 09 20 20 20 20 char port)..
7bf0: 20 20 28 63 6f 6e 73 20 70 69 2d 66 72 61 67 6d (cons pi-fragm
7c00: 65 6e 74 20 27 28 29 29 29 0a 09 20 20 20 20 28 ent '())).. (
7c10: 63 6f 6e 73 2a 20 70 69 2d 66 72 61 67 6d 65 6e cons* pi-fragmen
7c20: 74 20 22 3f 22 20 28 6c 6f 6f 70 29 29 29 29 29 t "?" (loop)))))
7c30: 29 29 0a 0a 0a 3b 28 64 65 66 69 6e 65 20 28 73 ))...;(define (s
7c40: 73 61 78 3a 72 65 61 64 2d 70 69 2d 62 6f 64 79 sax:read-pi-body
7c50: 2d 61 73 2d 6e 61 6d 65 2d 76 61 6c 75 65 73 20 -as-name-values
7c60: 70 6f 72 74 29 0a 0a 3b 20 54 68 65 20 63 75 72 port)..; The cur
7c70: 72 65 6e 74 20 70 6f 73 20 69 6e 20 74 68 65 20 rent pos in the
7c80: 70 6f 72 74 20 69 73 20 69 6e 73 69 64 65 20 61 port is inside a
7c90: 6e 20 69 6e 74 65 72 6e 61 6c 20 44 54 44 20 73 n internal DTD s
7ca0: 75 62 73 65 74 0a 3b 20 28 65 2e 67 2e 2c 20 61 ubset.; (e.g., a
7cb0: 66 74 65 72 20 72 65 61 64 69 6e 67 20 23 5c 5b fter reading #\[
7cc0: 20 74 68 61 74 20 62 65 67 69 6e 73 20 61 6e 20 that begins an
7cd0: 69 6e 74 65 72 6e 61 6c 20 44 54 44 20 73 75 62 internal DTD sub
7ce0: 73 65 74 29 0a 3b 20 53 6b 69 70 20 75 6e 74 69 set).; Skip unti
7cf0: 6c 20 74 68 65 20 22 5d 3e 22 20 63 6f 6d 62 69 l the "]>" combi
7d00: 6e 61 74 69 6f 6e 20 74 68 61 74 20 74 65 72 6d nation that term
7d10: 69 6e 61 74 65 73 20 74 68 69 73 20 44 54 44 0a inates this DTD.
7d20: 28 64 65 66 69 6e 65 20 28 73 73 61 78 3a 73 6b (define (ssax:sk
7d30: 69 70 2d 69 6e 74 65 72 6e 61 6c 2d 64 74 64 20 ip-internal-dtd
7d40: 70 6f 72 74 29 20 20 20 20 20 20 0a 20 20 28 69 port) . (i
7d50: 66 20 28 6e 6f 74 20 28 66 69 6e 64 2d 73 74 72 f (not (find-str
7d60: 69 6e 67 2d 66 72 6f 6d 2d 70 6f 72 74 3f 20 22 ing-from-port? "
7d70: 5d 3e 22 20 70 6f 72 74 29 29 0a 20 20 20 20 28 ]>" port)). (
7d80: 70 61 72 73 65 72 2d 65 72 72 6f 72 20 70 6f 72 parser-error por
7d90: 74 0a 09 09 20 20 22 46 61 69 6c 65 64 20 74 6f t... "Failed to
7da0: 20 66 69 6e 64 20 5d 3e 20 74 65 72 6d 69 6e 61 find ]> termina
7db0: 74 69 6e 67 20 74 68 65 20 69 6e 74 65 72 6e 61 ting the interna
7dc0: 6c 20 44 54 44 20 73 75 62 73 65 74 22 29 29 29 l DTD subset")))
7dd0: 0a 0a 0a 3b 20 70 72 6f 63 65 64 75 72 65 2b 3a ...; procedure+:
7de0: 20 09 73 73 61 78 3a 72 65 61 64 2d 63 64 61 74 .ssax:read-cdat
7df0: 61 2d 62 6f 64 79 20 50 4f 52 54 20 53 54 52 2d a-body PORT STR-
7e00: 48 41 4e 44 4c 45 52 20 53 45 45 44 0a 3b 0a 3b HANDLER SEED.;.;
7e10: 20 54 68 69 73 20 70 72 6f 63 65 64 75 72 65 20 This procedure
7e20: 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 64 20 61 must be called a
7e30: 66 74 65 72 20 77 65 20 68 61 76 65 20 72 65 61 fter we have rea
7e40: 64 20 61 20 73 74 72 69 6e 67 20 22 3c 21 5b 43 d a string "<![C
7e50: 44 41 54 41 5b 22 0a 3b 20 74 68 61 74 20 62 65 DATA[".; that be
7e60: 67 69 6e 73 20 61 20 43 44 41 54 41 20 73 65 63 gins a CDATA sec
7e70: 74 69 6f 6e 2e 20 54 68 65 20 63 75 72 72 65 6e tion. The curren
7e80: 74 20 70 6f 73 69 74 69 6f 6e 20 6d 75 73 74 20 t position must
7e90: 62 65 20 74 68 65 20 66 69 72 73 74 0a 3b 20 70 be the first.; p
7ea0: 6f 73 69 74 69 6f 6e 20 6f 66 20 74 68 65 20 43 osition of the C
7eb0: 44 41 54 41 20 62 6f 64 79 2e 20 54 68 69 73 20 DATA body. This
7ec0: 66 75 6e 63 74 69 6f 6e 20 72 65 61 64 73 20 5f function reads _
7ed0: 6c 69 6e 65 73 5f 20 6f 66 20 74 68 65 20 43 44 lines_ of the CD
7ee0: 41 54 41 0a 3b 20 62 6f 64 79 20 61 6e 64 20 70 ATA.; body and p
7ef0: 61 73 73 65 73 20 74 68 65 6d 20 74 6f 20 61 20 asses them to a
7f00: 53 54 52 2d 48 41 4e 44 4c 45 52 2c 20 61 20 63 STR-HANDLER, a c
7f10: 68 61 72 61 63 74 65 72 20 64 61 74 61 20 63 6f haracter data co
7f20: 6e 73 75 6d 65 72 2e 0a 3b 0a 3b 20 54 68 65 20 nsumer..;.; The
7f30: 73 74 72 2d 68 61 6e 64 6c 65 72 20 69 73 20 61 str-handler is a
7f40: 20 53 54 52 2d 48 41 4e 44 4c 45 52 2c 20 61 20 STR-HANDLER, a
7f50: 70 72 6f 63 65 64 75 72 65 20 53 54 52 49 4e 47 procedure STRING
7f60: 31 20 53 54 52 49 4e 47 32 20 53 45 45 44 2e 0a 1 STRING2 SEED..
7f70: 3b 20 54 68 65 20 66 69 72 73 74 20 53 54 52 49 ; The first STRI
7f80: 4e 47 31 20 61 72 67 75 6d 65 6e 74 20 74 6f 20 NG1 argument to
7f90: 53 54 52 2d 48 41 4e 44 4c 45 52 20 6e 65 76 65 STR-HANDLER neve
7fa0: 72 20 63 6f 6e 74 61 69 6e 73 20 61 20 6e 65 77 r contains a new
7fb0: 6c 69 6e 65 2e 0a 3b 20 54 68 65 20 73 65 63 6f line..; The seco
7fc0: 6e 64 20 53 54 52 49 4e 47 32 20 61 72 67 75 6d nd STRING2 argum
7fd0: 65 6e 74 20 6f 66 74 65 6e 20 77 69 6c 6c 2e 20 ent often will.
7fe0: 4f 6e 20 74 68 65 20 66 69 72 73 74 20 69 6e 76 On the first inv
7ff0: 6f 63 61 74 69 6f 6e 20 6f 66 0a 3b 20 74 68 65 ocation of.; the
8000: 20 53 54 52 2d 48 41 4e 44 4c 45 52 2c 20 74 68 STR-HANDLER, th
8010: 65 20 73 65 65 64 20 69 73 20 74 68 65 20 6f 6e e seed is the on
8020: 65 20 70 61 73 73 65 64 20 74 6f 20 73 73 61 78 e passed to ssax
8030: 3a 72 65 61 64 2d 63 64 61 74 61 2d 62 6f 64 79 :read-cdata-body
8040: 0a 3b 20 61 73 20 74 68 65 20 74 68 69 72 64 20 .; as the third
8050: 61 72 67 75 6d 65 6e 74 2e 20 54 68 65 20 72 65 argument. The re
8060: 73 75 6c 74 20 6f 66 20 74 68 69 73 20 66 69 72 sult of this fir
8070: 73 74 20 69 6e 76 6f 63 61 74 69 6f 6e 20 77 69 st invocation wi
8080: 6c 6c 20 62 65 0a 3b 20 70 61 73 73 65 64 20 61 ll be.; passed a
8090: 73 20 74 68 65 20 73 65 65 64 20 61 72 67 75 6d s the seed argum
80a0: 65 6e 74 20 74 6f 20 74 68 65 20 73 65 63 6f 6e ent to the secon
80b0: 64 20 69 6e 76 6f 63 61 74 69 6f 6e 20 6f 66 20 d invocation of
80c0: 74 68 65 20 6c 69 6e 65 0a 3b 20 63 6f 6e 73 75 the line.; consu
80d0: 6d 65 72 2c 20 61 6e 64 20 73 6f 20 6f 6e 2e 20 mer, and so on.
80e0: 54 68 65 20 72 65 73 75 6c 74 20 6f 66 20 74 68 The result of th
80f0: 65 20 6c 61 73 74 20 69 6e 76 6f 63 61 74 69 6f e last invocatio
8100: 6e 20 6f 66 20 74 68 65 0a 3b 20 53 54 52 2d 48 n of the.; STR-H
8110: 41 4e 44 4c 45 52 20 69 73 20 72 65 74 75 72 6e ANDLER is return
8120: 65 64 20 62 79 20 74 68 65 20 73 73 61 78 3a 72 ed by the ssax:r
8130: 65 61 64 2d 63 64 61 74 61 2d 62 6f 64 79 2e 20 ead-cdata-body.
8140: 20 4e 6f 74 65 20 61 0a 3b 20 73 69 6d 69 6c 61 Note a.; simila
8150: 72 69 74 79 20 74 6f 20 74 68 65 20 66 75 6e 64 rity to the fund
8160: 61 6d 65 6e 74 61 6c 20 27 66 6f 6c 64 27 20 69 amental 'fold' i
8170: 74 65 72 61 74 6f 72 2e 0a 3b 0a 3b 20 57 69 74 terator..;.; Wit
8180: 68 69 6e 20 61 20 43 44 41 54 41 20 73 65 63 74 hin a CDATA sect
8190: 69 6f 6e 20 61 6c 6c 20 63 68 61 72 61 63 74 65 ion all characte
81a0: 72 73 20 61 72 65 20 74 61 6b 65 6e 20 61 74 20 rs are taken at
81b0: 74 68 65 69 72 20 66 61 63 65 20 76 61 6c 75 65 their face value
81c0: 2c 0a 3b 20 77 69 74 68 20 6f 6e 6c 79 20 74 68 ,.; with only th
81d0: 72 65 65 20 65 78 63 65 70 74 69 6f 6e 73 3a 0a ree exceptions:.
81e0: 3b 09 43 52 2c 20 4c 46 2c 20 61 6e 64 20 43 52 ;.CR, LF, and CR
81f0: 4c 46 20 61 72 65 20 74 72 65 61 74 65 64 20 61 LF are treated a
8200: 73 20 6c 69 6e 65 20 64 65 6c 69 6d 69 74 65 72 s line delimiter
8210: 73 2c 20 61 6e 64 20 70 61 73 73 65 64 0a 3b 09 s, and passed.;.
8220: 61 73 20 61 20 73 69 6e 67 6c 65 20 23 5c 6e 65 as a single #\ne
8230: 77 6c 69 6e 65 20 74 6f 20 74 68 65 20 53 54 52 wline to the STR
8240: 2d 48 41 4e 44 4c 45 52 0a 3b 09 22 5d 5d 3e 22 -HANDLER.;."]]>"
8250: 20 63 6f 6d 62 69 6e 61 74 69 6f 6e 20 69 73 20 combination is
8260: 74 68 65 20 65 6e 64 20 6f 66 20 74 68 65 20 43 the end of the C
8270: 44 41 54 41 20 73 65 63 74 69 6f 6e 2e 0a 3b 09 DATA section..;.
8280: 26 67 74 3b 20 69 73 20 74 72 65 61 74 65 64 20 > is treated
8290: 61 73 20 61 6e 20 65 6d 62 65 64 64 65 64 20 23 as an embedded #
82a0: 5c 3e 20 63 68 61 72 61 63 74 65 72 0a 3b 20 4e \> character.; N
82b0: 6f 74 65 2c 20 26 6c 74 3b 20 61 6e 64 20 26 61 ote, < and &a
82c0: 6d 70 3b 20 61 72 65 20 6e 6f 74 20 73 70 65 63 mp; are not spec
82d0: 69 61 6c 6c 79 20 72 65 63 6f 67 6e 69 7a 65 64 ially recognized
82e0: 20 28 61 6e 64 20 61 72 65 20 6e 6f 74 20 65 78 (and are not ex
82f0: 70 61 6e 64 65 64 29 21 0a 0a 28 64 65 66 69 6e panded)!..(defin
8300: 65 20 73 73 61 78 3a 72 65 61 64 2d 63 64 61 74 e ssax:read-cdat
8310: 61 2d 62 6f 64 79 20 0a 20 20 28 6c 65 74 20 28 a-body . (let (
8320: 28 63 64 61 74 61 2d 64 65 6c 69 6d 69 74 65 72 (cdata-delimiter
8330: 73 20 28 6c 69 73 74 20 63 68 61 72 2d 72 65 74 s (list char-ret
8340: 75 72 6e 20 23 5c 6e 65 77 6c 69 6e 65 20 23 5c urn #\newline #\
8350: 5d 20 23 5c 26 29 29 29 0a 0a 20 20 20 20 28 6c ] #\&))).. (l
8360: 61 6d 62 64 61 20 28 70 6f 72 74 20 73 74 72 2d ambda (port str-
8370: 68 61 6e 64 6c 65 72 20 73 65 65 64 29 0a 20 20 handler seed).
8380: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
8390: 73 65 65 64 20 73 65 65 64 29 29 0a 09 28 6c 65 seed seed))..(le
83a0: 74 20 28 28 66 72 61 67 6d 65 6e 74 20 28 6e 65 t ((fragment (ne
83b0: 78 74 2d 74 6f 6b 65 6e 20 27 28 29 20 63 64 61 xt-token '() cda
83c0: 74 61 2d 64 65 6c 69 6d 69 74 65 72 73 0a 09 09 ta-delimiters...
83d0: 09 09 20 20 20 20 22 72 65 61 64 69 6e 67 20 43 .. "reading C
83e0: 44 41 54 41 22 20 70 6f 72 74 29 29 29 0a 09 09 DATA" port)))...
83f0: 09 3b 20 74 68 61 74 20 69 73 2c 20 77 65 27 72 .; that is, we'r
8400: 65 20 72 65 61 64 69 6e 67 20 74 68 65 20 63 68 e reading the ch
8410: 61 72 20 61 66 74 65 72 20 74 68 65 20 27 66 72 ar after the 'fr
8420: 61 67 6d 65 6e 74 27 0a 20 20 20 20 20 28 63 61 agment'. (ca
8430: 73 65 20 28 72 65 61 64 2d 63 68 61 72 20 70 6f se (read-char po
8440: 72 74 29 09 0a 20 20 20 20 20 20 20 28 28 23 5c rt).. ((#\
8450: 6e 65 77 6c 69 6e 65 29 20 28 6c 6f 6f 70 20 28 newline) (loop (
8460: 73 74 72 2d 68 61 6e 64 6c 65 72 20 66 72 61 67 str-handler frag
8470: 6d 65 6e 74 20 6e 6c 20 73 65 65 64 29 29 29 0a ment nl seed))).
8480: 20 20 20 20 20 20 20 28 28 23 5c 5d 29 0a 09 28 ((#\])..(
8490: 69 66 20 28 6e 6f 74 20 28 65 71 76 3f 20 28 70 if (not (eqv? (p
84a0: 65 65 6b 2d 63 68 61 72 20 70 6f 72 74 29 20 23 eek-char port) #
84b0: 5c 5d 29 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 \])).. (loop
84c0: 28 73 74 72 2d 68 61 6e 64 6c 65 72 20 66 72 61 (str-handler fra
84d0: 67 6d 65 6e 74 20 22 5d 22 20 73 65 65 64 29 29 gment "]" seed))
84e0: 0a 09 20 20 20 20 28 6c 65 74 20 63 68 65 63 6b .. (let check
84f0: 2d 61 66 74 65 72 2d 73 65 63 6f 6e 64 2d 62 72 -after-second-br
8500: 61 6b 65 74 0a 09 09 28 28 73 65 65 64 20 28 69 aket...((seed (i
8510: 66 20 28 73 74 72 69 6e 67 2d 6e 75 6c 6c 3f 20 f (string-null?
8520: 66 72 61 67 6d 65 6e 74 29 20 73 65 65 64 0a 09 fragment) seed..
8530: 09 09 20 20 20 28 73 74 72 2d 68 61 6e 64 6c 65 .. (str-handle
8540: 72 20 66 72 61 67 6d 65 6e 74 20 22 22 20 73 65 r fragment "" se
8550: 65 64 29 29 29 29 0a 09 20 20 20 20 20 20 28 63 ed)))).. (c
8560: 61 73 65 20 28 70 65 65 6b 2d 6e 65 78 74 2d 63 ase (peek-next-c
8570: 68 61 72 20 70 6f 72 74 29 09 3b 20 61 66 74 65 har port).; afte
8580: 72 20 74 68 65 20 73 65 63 6f 6e 64 20 62 72 61 r the second bra
8590: 63 6b 65 74 0a 09 09 28 28 23 5c 3e 29 20 28 72 cket...((#\>) (r
85a0: 65 61 64 2d 63 68 61 72 20 70 6f 72 74 29 09 73 ead-char port).s
85b0: 65 65 64 29 09 3b 20 77 65 20 68 61 76 65 20 72 eed).; we have r
85c0: 65 61 64 20 22 5d 5d 3e 22 0a 09 09 28 28 23 5c ead "]]>"...((#\
85d0: 5d 29 20 28 63 68 65 63 6b 2d 61 66 74 65 72 2d ]) (check-after-
85e0: 73 65 63 6f 6e 64 2d 62 72 61 6b 65 74 0a 09 09 second-braket...
85f0: 09 28 73 74 72 2d 68 61 6e 64 6c 65 72 20 22 5d .(str-handler "]
8600: 22 20 22 22 20 73 65 65 64 29 29 29 0a 09 09 28 " "" seed)))...(
8610: 65 6c 73 65 20 28 6c 6f 6f 70 20 28 73 74 72 2d else (loop (str-
8620: 68 61 6e 64 6c 65 72 20 22 5d 5d 22 20 22 22 20 handler "]]" ""
8630: 73 65 65 64 29 29 29 29 29 29 29 0a 20 20 20 20 seed))))))).
8640: 20 20 20 28 28 23 5c 26 29 09 09 3b 20 4e 6f 74 ((#\&)..; Not
8650: 65 20 74 68 61 74 20 23 5c 26 20 77 69 74 68 69 e that #\& withi
8660: 6e 20 43 44 41 54 41 20 6d 61 79 20 73 74 61 6e n CDATA may stan
8670: 64 20 66 6f 72 20 69 74 73 65 6c 66 0a 09 28 6c d for itself..(l
8680: 65 74 20 28 28 65 6e 74 2d 72 65 66 20 09 3b 20 et ((ent-ref .;
8690: 69 74 20 64 6f 65 73 20 6e 6f 74 20 68 61 76 65 it does not have
86a0: 20 74 6f 20 73 74 61 72 74 20 61 6e 20 65 6e 74 to start an ent
86b0: 69 74 79 20 72 65 66 0a 20 20 20 20 20 20 20 20 ity ref.
86c0: 20 20 20 20 20 20 20 28 6e 65 78 74 2d 74 6f 6b (next-tok
86d0: 65 6e 2d 6f 66 20 28 6c 61 6d 62 64 61 20 28 63 en-of (lambda (c
86e0: 29 20 0a 09 09 20 28 61 6e 64 20 28 6e 6f 74 20 ) ... (and (not
86f0: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 63 29 29 (eof-object? c))
8700: 20 28 63 68 61 72 2d 61 6c 70 68 61 62 65 74 69 (char-alphabeti
8710: 63 3f 20 63 29 20 63 29 29 20 70 6f 72 74 29 29 c? c) c)) port))
8720: 29 0a 09 20 20 28 63 6f 6e 64 09 09 3b 20 22 26 ).. (cond..; "&
8730: 67 74 3b 22 20 69 73 20 74 6f 20 62 65 20 72 65 gt;" is to be re
8740: 70 6c 61 63 65 64 20 77 69 74 68 20 23 5c 3e 0a placed with #\>.
8750: 09 20 20 20 28 28 61 6e 64 20 28 73 74 72 69 6e . ((and (strin
8760: 67 3d 3f 20 22 67 74 22 20 65 6e 74 2d 72 65 66 g=? "gt" ent-ref
8770: 29 20 28 65 71 76 3f 20 28 70 65 65 6b 2d 63 68 ) (eqv? (peek-ch
8780: 61 72 20 70 6f 72 74 29 20 23 5c 3b 29 29 0a 09 ar port) #\;))..
8790: 20 20 20 20 28 72 65 61 64 2d 63 68 61 72 20 70 (read-char p
87a0: 6f 72 74 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 ort).. (loop
87b0: 28 73 74 72 2d 68 61 6e 64 6c 65 72 20 66 72 61 (str-handler fra
87c0: 67 6d 65 6e 74 20 22 3e 22 20 73 65 65 64 29 29 gment ">" seed))
87d0: 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 ).. (else..
87e0: 20 28 6c 6f 6f 70 20 0a 09 20 20 20 20 20 28 73 (loop .. (s
87f0: 74 72 2d 68 61 6e 64 6c 65 72 20 65 6e 74 2d 72 tr-handler ent-r
8800: 65 66 20 22 22 0a 09 09 09 20 20 28 73 74 72 2d ef "".... (str-
8810: 68 61 6e 64 6c 65 72 20 66 72 61 67 6d 65 6e 74 handler fragment
8820: 20 22 26 22 20 73 65 65 64 29 29 29 29 29 29 29 "&" seed)))))))
8830: 0a 20 20 20 20 20 20 20 28 65 6c 73 65 09 09 3b . (else..;
8840: 20 4d 75 73 74 20 62 65 20 43 52 3a 20 69 66 20 Must be CR: if
8850: 74 68 65 20 6e 65 78 74 20 63 68 61 72 20 69 73 the next char is
8860: 20 23 5c 6e 65 77 6c 69 6e 65 2c 20 73 6b 69 70 #\newline, skip
8870: 20 69 74 0a 20 20 20 20 20 20 20 20 20 28 69 66 it. (if
8880: 20 28 65 71 76 3f 20 28 70 65 65 6b 2d 63 68 61 (eqv? (peek-cha
8890: 72 20 70 6f 72 74 29 20 23 5c 6e 65 77 6c 69 6e r port) #\newlin
88a0: 65 29 20 28 72 65 61 64 2d 63 68 61 72 20 70 6f e) (read-char po
88b0: 72 74 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c rt)). (l
88c0: 6f 6f 70 20 28 73 74 72 2d 68 61 6e 64 6c 65 72 oop (str-handler
88d0: 20 66 72 61 67 6d 65 6e 74 20 6e 6c 20 73 65 65 fragment nl see
88e0: 64 29 29 29 0a 20 20 20 20 20 20 20 29 29 29 29 d))). ))))
88f0: 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))..
8900: 0a 3b 20 70 72 6f 63 65 64 75 72 65 2b 3a 09 73 .; procedure+:.s
8910: 73 61 78 3a 72 65 61 64 2d 63 68 61 72 2d 72 65 sax:read-char-re
8920: 66 20 50 4f 52 54 0a 3b 0a 3b 20 5b 36 36 5d 20 f PORT.;.; [66]
8930: 20 43 68 61 72 52 65 66 20 3a 3a 3d 20 20 27 26 CharRef ::= '&
8940: 23 27 20 5b 30 2d 39 5d 2b 20 27 3b 27 20 0a 3b #' [0-9]+ ';' .;
8950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8960: 20 20 7c 20 27 26 23 78 27 20 5b 30 2d 39 61 2d | '&#x' [0-9a-
8970: 66 41 2d 46 5d 2b 20 27 3b 27 0a 3b 0a 3b 20 54 fA-F]+ ';'.;.; T
8980: 68 69 73 20 70 72 6f 63 65 64 75 72 65 20 6d 75 his procedure mu
8990: 73 74 20 62 65 20 63 61 6c 6c 65 64 20 61 66 74 st be called aft
89a0: 65 72 20 77 65 20 77 65 20 68 61 76 65 20 72 65 er we we have re
89b0: 61 64 20 22 26 23 22 20 0a 3b 20 74 68 61 74 20 ad "&#" .; that
89c0: 69 6e 74 72 6f 64 75 63 65 73 20 61 20 63 68 61 introduces a cha
89d0: 72 20 72 65 66 65 72 65 6e 63 65 2e 0a 3b 20 54 r reference..; T
89e0: 68 65 20 70 72 6f 63 65 64 75 72 65 20 72 65 61 he procedure rea
89f0: 64 73 20 74 68 69 73 20 72 65 66 65 72 65 6e 63 ds this referenc
8a00: 65 20 61 6e 64 20 72 65 74 75 72 6e 73 20 74 68 e and returns th
8a10: 65 20 63 6f 72 72 65 73 70 6f 6e 64 69 6e 67 20 e corresponding
8a20: 63 68 61 72 0a 3b 20 54 68 65 20 63 75 72 72 65 char.; The curre
8a30: 6e 74 20 70 6f 73 69 74 69 6f 6e 20 69 6e 20 50 nt position in P
8a40: 4f 52 54 20 77 69 6c 6c 20 62 65 20 61 66 74 65 ORT will be afte
8a50: 72 20 22 3b 22 20 74 68 61 74 20 74 65 72 6d 69 r ";" that termi
8a60: 6e 61 74 65 73 0a 3b 20 74 68 65 20 63 68 61 72 nates.; the char
8a70: 20 72 65 66 65 72 65 6e 63 65 0a 3b 20 46 61 75 reference.; Fau
8a80: 6c 74 73 20 64 65 74 65 63 74 65 64 3a 0a 3b 09 lts detected:.;.
8a90: 57 46 43 3a 20 58 4d 4c 2d 53 70 65 63 2e 68 74 WFC: XML-Spec.ht
8aa0: 6d 6c 23 77 66 2d 4c 65 67 61 6c 63 68 61 72 0a ml#wf-Legalchar.
8ab0: 3b 0a 3b 20 41 63 63 6f 72 64 69 6e 67 20 74 6f ;.; According to
8ac0: 20 53 65 63 74 69 6f 6e 20 22 34 2e 31 20 43 68 Section "4.1 Ch
8ad0: 61 72 61 63 74 65 72 20 61 6e 64 20 45 6e 74 69 aracter and Enti
8ae0: 74 79 20 52 65 66 65 72 65 6e 63 65 73 22 0a 3b ty References".;
8af0: 20 6f 66 20 74 68 65 20 58 4d 4c 20 52 65 63 6f of the XML Reco
8b00: 6d 6d 65 6e 64 61 74 69 6f 6e 3a 0a 3b 20 20 22 mmendation:.; "
8b10: 5b 44 65 66 69 6e 69 74 69 6f 6e 3a 20 41 20 63 [Definition: A c
8b20: 68 61 72 61 63 74 65 72 20 72 65 66 65 72 65 6e haracter referen
8b30: 63 65 20 72 65 66 65 72 73 20 74 6f 20 61 20 73 ce refers to a s
8b40: 70 65 63 69 66 69 63 20 63 68 61 72 61 63 74 65 pecific characte
8b50: 72 0a 3b 20 20 20 69 6e 20 74 68 65 20 49 53 4f r.; in the ISO
8b60: 2f 49 45 43 20 31 30 36 34 36 20 63 68 61 72 61 /IEC 10646 chara
8b70: 63 74 65 72 20 73 65 74 2c 20 66 6f 72 20 65 78 cter set, for ex
8b80: 61 6d 70 6c 65 20 6f 6e 65 20 6e 6f 74 20 64 69 ample one not di
8b90: 72 65 63 74 6c 79 0a 3b 20 20 20 61 63 63 65 73 rectly.; acces
8ba0: 73 69 62 6c 65 20 66 72 6f 6d 20 61 76 61 69 6c sible from avail
8bb0: 61 62 6c 65 20 69 6e 70 75 74 20 64 65 76 69 63 able input devic
8bc0: 65 73 2e 5d 22 0a 3b 20 54 68 65 72 65 66 6f 72 es.]".; Therefor
8bd0: 65 2c 20 77 65 20 75 73 65 20 61 20 75 63 73 63 e, we use a ucsc
8be0: 6f 64 65 2d 3e 63 68 61 72 20 66 75 6e 63 74 69 ode->char functi
8bf0: 6f 6e 20 74 6f 20 63 6f 6e 76 65 72 74 20 61 20 on to convert a
8c00: 63 68 61 72 61 63 74 65 72 0a 3b 20 63 6f 64 65 character.; code
8c10: 20 69 6e 74 6f 20 74 68 65 20 63 68 61 72 61 63 into the charac
8c20: 74 65 72 20 2d 2d 20 2a 72 65 67 61 72 64 6c 65 ter -- *regardle
8c30: 73 73 2a 20 6f 66 20 74 68 65 20 63 75 72 72 65 ss* of the curre
8c40: 6e 74 20 63 68 61 72 61 63 74 65 72 0a 3b 20 65 nt character.; e
8c50: 6e 63 6f 64 69 6e 67 20 6f 66 20 74 68 65 20 69 ncoding of the i
8c60: 6e 70 75 74 20 73 74 72 65 61 6d 2e 0a 0a 28 64 nput stream...(d
8c70: 65 66 69 6e 65 20 28 73 73 61 78 3a 72 65 61 64 efine (ssax:read
8c80: 2d 63 68 61 72 2d 72 65 66 20 70 6f 72 74 29 0a -char-ref port).
8c90: 20 20 28 6c 65 74 2a 20 28 28 62 61 73 65 0a 20 (let* ((base.
8ca0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 20 (cond
8cb0: 28 28 65 71 76 3f 20 28 70 65 65 6b 2d 63 68 61 ((eqv? (peek-cha
8cc0: 72 20 70 6f 72 74 29 20 23 5c 78 29 20 28 72 65 r port) #\x) (re
8cd0: 61 64 2d 63 68 61 72 20 70 6f 72 74 29 20 31 36 ad-char port) 16
8ce0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8cf0: 20 20 20 28 65 6c 73 65 20 31 30 29 29 29 0a 20 (else 10))).
8d00: 20 20 20 20 20 20 20 20 28 6e 61 6d 65 20 28 6e (name (n
8d10: 65 78 74 2d 74 6f 6b 65 6e 20 27 28 29 20 27 28 ext-token '() '(
8d20: 23 5c 3b 29 20 22 58 4d 4c 20 5b 36 36 5d 22 20 #\;) "XML [66]"
8d30: 70 6f 72 74 29 29 0a 20 20 20 20 20 20 20 20 20 port)).
8d40: 28 63 68 61 72 2d 63 6f 64 65 20 28 73 74 72 69 (char-code (stri
8d50: 6e 67 2d 3e 6e 75 6d 62 65 72 20 6e 61 6d 65 20 ng->number name
8d60: 62 61 73 65 29 29 29 0a 20 20 20 20 28 72 65 61 base))). (rea
8d70: 64 2d 63 68 61 72 20 70 6f 72 74 29 09 3b 20 72 d-char port).; r
8d80: 65 61 64 20 74 68 65 20 74 65 72 6d 69 6e 61 74 ead the terminat
8d90: 69 6e 67 20 23 5c 3b 20 63 68 61 72 0a 20 20 20 ing #\; char.
8da0: 20 28 69 66 20 28 69 6e 74 65 67 65 72 3f 20 63 (if (integer? c
8db0: 68 61 72 2d 63 6f 64 65 29 20 28 75 63 73 63 6f har-code) (ucsco
8dc0: 64 65 2d 3e 63 68 61 72 20 63 68 61 72 2d 63 6f de->char char-co
8dd0: 64 65 29 0a 20 20 20 20 20 20 28 70 61 72 73 65 de). (parse
8de0: 72 2d 65 72 72 6f 72 20 70 6f 72 74 20 22 5b 77 r-error port "[w
8df0: 66 2d 4c 65 67 61 6c 63 68 61 72 5d 20 62 72 6f f-Legalchar] bro
8e00: 6b 65 6e 20 66 6f 72 20 27 22 20 6e 61 6d 65 20 ken for '" name
8e10: 22 27 22 29 29 29 29 0a 0a 0a 3b 20 70 72 6f 63 "'"))))...; proc
8e20: 65 64 75 72 65 2b 3a 09 73 73 61 78 3a 68 61 6e edure+:.ssax:han
8e30: 64 6c 65 2d 70 61 72 73 65 64 2d 65 6e 74 69 74 dle-parsed-entit
8e40: 79 20 50 4f 52 54 20 4e 41 4d 45 20 45 4e 54 49 y PORT NAME ENTI
8e50: 54 49 45 53 20 0a 3b 09 09 43 4f 4e 54 45 4e 54 TIES .;..CONTENT
8e60: 2d 48 41 4e 44 4c 45 52 20 53 54 52 2d 48 41 4e -HANDLER STR-HAN
8e70: 44 4c 45 52 20 53 45 45 44 0a 3b 0a 3b 20 45 78 DLER SEED.;.; Ex
8e80: 70 61 6e 64 20 61 6e 64 20 68 61 6e 64 6c 65 20 pand and handle
8e90: 61 20 70 61 72 73 65 64 2d 65 6e 74 69 74 79 20 a parsed-entity
8ea0: 72 65 66 65 72 65 6e 63 65 0a 3b 20 70 6f 72 74 reference.; port
8eb0: 20 2d 20 61 20 50 4f 52 54 0a 3b 20 6e 61 6d 65 - a PORT.; name
8ec0: 20 2d 20 74 68 65 20 6e 61 6d 65 20 6f 66 20 74 - the name of t
8ed0: 68 65 20 70 61 72 73 65 64 20 65 6e 74 69 74 79 he parsed entity
8ee0: 20 74 6f 20 65 78 70 61 6e 64 2c 20 61 20 73 79 to expand, a sy
8ef0: 6d 62 6f 6c 0a 3b 20 65 6e 74 69 74 69 65 73 20 mbol.; entities
8f00: 2d 20 73 65 65 20 45 4e 54 49 54 49 45 53 0a 3b - see ENTITIES.;
8f10: 20 63 6f 6e 74 65 6e 74 2d 68 61 6e 64 6c 65 72 content-handler
8f20: 20 2d 2d 20 70 72 6f 63 65 64 75 72 65 20 50 4f -- procedure PO
8f30: 52 54 20 45 4e 54 49 54 49 45 53 20 53 45 45 44 RT ENTITIES SEED
8f40: 0a 3b 09 74 68 61 74 20 69 73 20 73 75 70 70 6f .;.that is suppo
8f50: 73 65 64 20 74 6f 20 72 65 74 75 72 6e 20 61 20 sed to return a
8f60: 53 45 45 44 0a 3b 20 73 74 72 2d 68 61 6e 64 6c SEED.; str-handl
8f70: 65 72 20 2d 20 61 20 53 54 52 2d 48 41 4e 44 4c er - a STR-HANDL
8f80: 45 52 2e 20 49 74 20 69 73 20 63 61 6c 6c 65 64 ER. It is called
8f90: 20 69 66 20 74 68 65 20 65 6e 74 69 74 79 20 69 if the entity i
8fa0: 6e 20 71 75 65 73 74 69 6f 6e 0a 3b 20 74 75 72 n question.; tur
8fb0: 6e 73 20 6f 75 74 20 74 6f 20 62 65 20 61 20 70 ns out to be a p
8fc0: 72 65 2d 64 65 63 6c 61 72 65 64 20 65 6e 74 69 re-declared enti
8fd0: 74 79 0a 3b 0a 3b 20 54 68 65 20 72 65 73 75 6c ty.;.; The resul
8fe0: 74 20 69 73 20 74 68 65 20 6f 6e 65 20 72 65 74 t is the one ret
8ff0: 75 72 6e 65 64 20 62 79 20 43 4f 4e 54 45 4e 54 urned by CONTENT
9000: 2d 48 41 4e 44 4c 45 52 20 6f 72 20 53 54 52 2d -HANDLER or STR-
9010: 48 41 4e 44 4c 45 52 0a 3b 20 46 61 75 6c 74 73 HANDLER.; Faults
9020: 20 64 65 74 65 63 74 65 64 3a 0a 3b 09 57 46 43 detected:.;.WFC
9030: 3a 20 58 4d 4c 2d 53 70 65 63 2e 68 74 6d 6c 23 : XML-Spec.html#
9040: 77 66 2d 65 6e 74 64 65 63 6c 61 72 65 64 0a 3b wf-entdeclared.;
9050: 09 57 46 43 3a 20 58 4d 4c 2d 53 70 65 63 2e 68 .WFC: XML-Spec.h
9060: 74 6d 6c 23 6e 6f 72 65 63 75 72 73 69 6f 6e 0a tml#norecursion.
9070: 0a 28 64 65 66 69 6e 65 20 73 73 61 78 3a 70 72 .(define ssax:pr
9080: 65 64 65 66 69 6e 65 64 2d 70 61 72 73 65 64 2d edefined-parsed-
9090: 65 6e 74 69 74 69 65 73 0a 20 20 60 28 0a 20 20 entities. `(.
90a0: 20 20 28 2c 28 73 74 72 69 6e 67 2d 3e 73 79 6d (,(string->sym
90b0: 62 6f 6c 20 22 61 6d 70 22 29 20 2e 20 22 26 22 bol "amp") . "&"
90c0: 29 0a 20 20 20 20 28 2c 28 73 74 72 69 6e 67 2d ). (,(string-
90d0: 3e 73 79 6d 62 6f 6c 20 22 6c 74 22 29 20 2e 20 >symbol "lt") .
90e0: 22 3c 22 29 0a 20 20 20 20 28 2c 28 73 74 72 69 "<"). (,(stri
90f0: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 67 74 22 29 ng->symbol "gt")
9100: 20 2e 20 22 3e 22 29 0a 20 20 20 20 28 2c 28 73 . ">"). (,(s
9110: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 61 tring->symbol "a
9120: 70 6f 73 22 29 20 2e 20 22 27 22 29 0a 20 20 20 pos") . "'").
9130: 20 28 2c 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 (,(string->symb
9140: 6f 6c 20 22 71 75 6f 74 22 29 20 2e 20 22 5c 22 ol "quot") . "\"
9150: 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 ")))..(define (s
9160: 73 61 78 3a 68 61 6e 64 6c 65 2d 70 61 72 73 65 sax:handle-parse
9170: 64 2d 65 6e 74 69 74 79 20 70 6f 72 74 20 6e 61 d-entity port na
9180: 6d 65 20 65 6e 74 69 74 69 65 73 0a 09 09 09 09 me entities.....
9190: 20 20 20 63 6f 6e 74 65 6e 74 2d 68 61 6e 64 6c content-handl
91a0: 65 72 20 73 74 72 2d 68 61 6e 64 6c 65 72 20 73 er str-handler s
91b0: 65 65 64 29 0a 20 20 28 63 6f 6e 64 09 20 20 3b eed). (cond. ;
91c0: 20 46 69 72 73 74 20 77 65 20 63 68 65 63 6b 20 First we check
91d0: 74 68 65 20 6c 69 73 74 20 6f 66 20 74 68 65 20 the list of the
91e0: 64 65 63 6c 61 72 65 64 20 65 6e 74 69 74 69 65 declared entitie
91f0: 73 0a 20 20 20 28 28 61 73 73 71 20 6e 61 6d 65 s. ((assq name
9200: 20 65 6e 74 69 74 69 65 73 29 20 3d 3e 0a 20 20 entities) =>.
9210: 20 20 28 6c 61 6d 62 64 61 20 28 64 65 63 6c 2d (lambda (decl-
9220: 65 6e 74 69 74 79 29 0a 20 20 20 20 20 20 28 6c entity). (l
9230: 65 74 20 28 28 65 6e 74 2d 62 6f 64 79 20 28 63 et ((ent-body (c
9240: 64 72 20 64 65 63 6c 2d 65 6e 74 69 74 79 29 29 dr decl-entity))
9250: 20 3b 20 6d 61 72 6b 20 74 68 65 20 6c 69 73 74 ; mark the list
9260: 20 74 6f 20 70 72 65 76 65 6e 74 20 72 65 63 75 to prevent recu
9270: 72 73 69 6f 6e 0a 09 20 20 20 20 28 6e 65 77 2d rsion.. (new-
9280: 65 6e 74 69 74 69 65 73 20 28 63 6f 6e 73 20 28 entities (cons (
9290: 63 6f 6e 73 20 6e 61 6d 65 20 23 66 29 20 65 6e cons name #f) en
92a0: 74 69 74 69 65 73 29 29 29 0a 09 28 63 6f 6e 64 tities)))..(cond
92b0: 0a 09 20 28 28 73 74 72 69 6e 67 3f 20 65 6e 74 .. ((string? ent
92c0: 2d 62 6f 64 79 29 0a 09 20 20 28 63 61 6c 6c 2d -body).. (call-
92d0: 77 69 74 68 2d 69 6e 70 75 74 2d 73 74 72 69 6e with-input-strin
92e0: 67 20 65 6e 74 2d 62 6f 64 79 0a 09 20 20 20 20 g ent-body..
92f0: 20 28 6c 61 6d 62 64 61 20 28 70 6f 72 74 29 20 (lambda (port)
9300: 28 63 6f 6e 74 65 6e 74 2d 68 61 6e 64 6c 65 72 (content-handler
9310: 20 70 6f 72 74 20 6e 65 77 2d 65 6e 74 69 74 69 port new-entiti
9320: 65 73 20 73 65 65 64 29 29 29 29 0a 09 20 28 28 es seed)))).. ((
9330: 70 72 6f 63 65 64 75 72 65 3f 20 65 6e 74 2d 62 procedure? ent-b
9340: 6f 64 79 29 0a 09 20 20 28 6c 65 74 20 28 28 70 ody).. (let ((p
9350: 6f 72 74 20 28 65 6e 74 2d 62 6f 64 79 29 29 29 ort (ent-body)))
9360: 0a 09 20 20 20 20 28 62 65 67 69 6e 30 0a 09 20 .. (begin0..
9370: 20 20 20 20 28 63 6f 6e 74 65 6e 74 2d 68 61 6e (content-han
9380: 64 6c 65 72 20 70 6f 72 74 20 6e 65 77 2d 65 6e dler port new-en
9390: 74 69 74 69 65 73 20 73 65 65 64 29 0a 09 20 20 tities seed)..
93a0: 20 20 20 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d (close-input-
93b0: 70 6f 72 74 20 70 6f 72 74 29 29 29 29 0a 09 20 port port))))..
93c0: 28 65 6c 73 65 0a 09 20 20 28 70 61 72 73 65 72 (else.. (parser
93d0: 2d 65 72 72 6f 72 20 70 6f 72 74 20 22 5b 6e 6f -error port "[no
93e0: 72 65 63 75 72 73 69 6f 6e 5d 20 62 72 6f 6b 65 recursion] broke
93f0: 6e 20 66 6f 72 20 22 20 6e 61 6d 65 29 29 29 29 n for " name))))
9400: 29 29 0a 20 20 20 20 28 28 61 73 73 71 20 6e 61 )). ((assq na
9410: 6d 65 20 73 73 61 78 3a 70 72 65 64 65 66 69 6e me ssax:predefin
9420: 65 64 2d 70 61 72 73 65 64 2d 65 6e 74 69 74 69 ed-parsed-entiti
9430: 65 73 29 0a 20 20 20 20 20 3d 3e 20 28 6c 61 6d es). => (lam
9440: 62 64 61 20 28 64 65 63 6c 2d 65 6e 74 69 74 79 bda (decl-entity
9450: 29 0a 09 20 20 28 73 74 72 2d 68 61 6e 64 6c 65 ).. (str-handle
9460: 72 20 28 63 64 72 20 64 65 63 6c 2d 65 6e 74 69 r (cdr decl-enti
9470: 74 79 29 20 22 22 20 73 65 65 64 29 29 29 0a 20 ty) "" seed))).
9480: 20 20 20 28 65 6c 73 65 20 28 70 61 72 73 65 72 (else (parser
9490: 2d 65 72 72 6f 72 20 70 6f 72 74 20 22 5b 77 66 -error port "[wf
94a0: 2d 65 6e 74 64 65 63 6c 61 72 65 64 5d 20 62 72 -entdeclared] br
94b0: 6f 6b 65 6e 20 66 6f 72 20 22 20 6e 61 6d 65 29 oken for " name)
94c0: 29 29 29 0a 0a 0a 0a 3b 20 54 68 65 20 41 54 54 )))....; The ATT
94d0: 4c 49 53 54 20 41 62 73 74 72 61 63 74 20 44 61 LIST Abstract Da
94e0: 74 61 20 54 79 70 65 0a 3b 20 43 75 72 72 65 6e ta Type.; Curren
94f0: 74 6c 79 20 69 73 20 69 6d 70 6c 65 6d 65 6e 74 tly is implement
9500: 65 64 20 61 73 20 61 6e 20 61 73 73 6f 63 20 6c ed as an assoc l
9510: 69 73 74 20 73 6f 72 74 65 64 20 69 6e 20 74 68 ist sorted in th
9520: 65 20 61 73 63 65 6e 64 69 6e 67 0a 3b 20 6f 72 e ascending.; or
9530: 64 65 72 20 6f 66 20 4e 41 4d 45 53 2e 0a 0a 28 der of NAMES...(
9540: 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 65 6d 70 define (make-emp
9550: 74 79 2d 61 74 74 6c 69 73 74 29 20 27 28 29 29 ty-attlist) '())
9560: 0a 0a 3b 20 41 64 64 20 61 20 6e 61 6d 65 2d 76 ..; Add a name-v
9570: 61 6c 75 65 20 70 61 69 72 20 74 6f 20 74 68 65 alue pair to the
9580: 20 65 78 69 73 74 69 6e 67 20 61 74 74 6c 69 73 existing attlis
9590: 74 20 70 72 65 73 65 72 76 69 6e 67 20 74 68 65 t preserving the
95a0: 20 6f 72 64 65 72 0a 3b 20 52 65 74 75 72 6e 20 order.; Return
95b0: 74 68 65 20 6e 65 77 20 6c 69 73 74 2c 20 69 6e the new list, in
95c0: 20 74 68 65 20 73 6f 72 74 65 64 20 61 73 63 65 the sorted asce
95d0: 6e 64 69 6e 67 20 6f 72 64 65 72 2e 0a 3b 20 52 nding order..; R
95e0: 65 74 75 72 6e 20 23 66 20 69 66 20 61 20 70 61 eturn #f if a pa
95f0: 69 72 20 77 69 74 68 20 74 68 65 20 73 61 6d 65 ir with the same
9600: 20 6e 61 6d 65 20 61 6c 72 65 61 64 79 20 65 78 name already ex
9610: 69 73 74 73 20 69 6e 20 74 68 65 20 61 74 74 6c ists in the attl
9620: 69 73 74 0a 0a 28 64 65 66 69 6e 65 20 28 61 74 ist..(define (at
9630: 74 6c 69 73 74 2d 61 64 64 20 61 74 74 6c 69 73 tlist-add attlis
9640: 74 20 6e 61 6d 65 2d 76 61 6c 75 65 29 0a 20 20 t name-value).
9650: 28 69 66 20 28 6e 75 6c 6c 3f 20 61 74 74 6c 69 (if (null? attli
9660: 73 74 29 20 28 63 6f 6e 73 20 6e 61 6d 65 2d 76 st) (cons name-v
9670: 61 6c 75 65 20 61 74 74 6c 69 73 74 29 0a 20 20 alue attlist).
9680: 20 20 20 20 28 63 61 73 65 20 28 6e 61 6d 65 2d (case (name-
9690: 63 6f 6d 70 61 72 65 20 28 63 61 72 20 6e 61 6d compare (car nam
96a0: 65 2d 76 61 6c 75 65 29 20 28 63 61 61 72 20 61 e-value) (caar a
96b0: 74 74 6c 69 73 74 29 29 0a 09 28 28 3d 29 20 23 ttlist))..((=) #
96c0: 66 29 0a 09 28 28 3c 29 20 28 63 6f 6e 73 20 6e f)..((<) (cons n
96d0: 61 6d 65 2d 76 61 6c 75 65 20 61 74 74 6c 69 73 ame-value attlis
96e0: 74 29 29 0a 09 28 65 6c 73 65 20 28 63 6f 6e 73 t))..(else (cons
96f0: 20 28 63 61 72 20 61 74 74 6c 69 73 74 29 20 28 (car attlist) (
9700: 61 74 74 6c 69 73 74 2d 61 64 64 20 28 63 64 72 attlist-add (cdr
9710: 20 61 74 74 6c 69 73 74 29 20 6e 61 6d 65 2d 76 attlist) name-v
9720: 61 6c 75 65 29 29 29 0a 09 29 29 29 0a 0a 28 64 alue)))..)))..(d
9730: 65 66 69 6e 65 20 61 74 74 6c 69 73 74 2d 6e 75 efine attlist-nu
9740: 6c 6c 3f 20 6e 75 6c 6c 3f 29 0a 0a 3b 20 47 69 ll? null?)..; Gi
9750: 76 65 6e 20 61 6e 20 6e 6f 6e 2d 6e 75 6c 6c 20 ven an non-null
9760: 61 74 74 6c 69 73 74 2c 20 72 65 74 75 72 6e 20 attlist, return
9770: 61 20 70 61 69 72 20 6f 66 20 76 61 6c 75 65 73 a pair of values
9780: 3a 20 74 68 65 20 74 6f 70 20 61 6e 64 20 74 68 : the top and th
9790: 65 20 72 65 73 74 0a 28 64 65 66 69 6e 65 20 28 e rest.(define (
97a0: 61 74 74 6c 69 73 74 2d 72 65 6d 6f 76 65 2d 74 attlist-remove-t
97b0: 6f 70 20 61 74 74 6c 69 73 74 29 0a 20 20 28 76 op attlist). (v
97c0: 61 6c 75 65 73 20 28 63 61 72 20 61 74 74 6c 69 alues (car attli
97d0: 73 74 29 20 28 63 64 72 20 61 74 74 6c 69 73 74 st) (cdr attlist
97e0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 61 74 )))..(define (at
97f0: 74 6c 69 73 74 2d 3e 61 6c 69 73 74 20 61 74 74 tlist->alist att
9800: 6c 69 73 74 29 20 61 74 74 6c 69 73 74 29 0a 28 list) attlist).(
9810: 64 65 66 69 6e 65 20 61 74 74 6c 69 73 74 2d 66 define attlist-f
9820: 6f 6c 64 20 66 6f 6c 64 29 0a 0a 3b 20 70 72 6f old fold)..; pro
9830: 63 65 64 75 72 65 2b 3a 09 73 73 61 78 3a 72 65 cedure+:.ssax:re
9840: 61 64 2d 61 74 74 72 69 62 75 74 65 73 20 50 4f ad-attributes PO
9850: 52 54 20 45 4e 54 49 54 49 45 53 0a 3b 0a 3b 20 RT ENTITIES.;.;
9860: 54 68 69 73 20 70 72 6f 63 65 64 75 72 65 20 72 This procedure r
9870: 65 61 64 73 20 61 6e 64 20 70 61 72 73 65 73 20 eads and parses
9880: 61 20 70 72 6f 64 75 63 74 69 6f 6e 20 41 74 74 a production Att
9890: 72 69 62 75 74 65 2a 0a 3b 20 5b 34 31 5d 20 41 ribute*.; [41] A
98a0: 74 74 72 69 62 75 74 65 20 3a 3a 3d 20 4e 61 6d ttribute ::= Nam
98b0: 65 20 45 71 20 41 74 74 56 61 6c 75 65 0a 3b 20 e Eq AttValue.;
98c0: 5b 31 30 5d 20 41 74 74 56 61 6c 75 65 20 3a 3a [10] AttValue ::
98d0: 3d 20 20 27 22 27 20 28 5b 5e 3c 26 22 5d 20 7c = '"' ([^<&"] |
98e0: 20 52 65 66 65 72 65 6e 63 65 29 2a 20 27 22 27 Reference)* '"'
98f0: 20 0a 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;
9900: 20 20 20 20 7c 20 22 27 22 20 28 5b 5e 3c 26 27 | "'" ([^<&'
9910: 5d 20 7c 20 52 65 66 65 72 65 6e 63 65 29 2a 20 ] | Reference)*
9920: 22 27 22 0a 3b 20 5b 32 35 5d 20 45 71 20 3a 3a "'".; [25] Eq ::
9930: 3d 20 53 3f 20 27 3d 27 20 53 3f 0a 3b 0a 3b 0a = S? '=' S?.;.;.
9940: 3b 20 54 68 65 20 70 72 6f 63 65 64 75 72 65 20 ; The procedure
9950: 72 65 74 75 72 6e 73 20 61 6e 20 41 54 54 4c 49 returns an ATTLI
9960: 53 54 2c 20 6f 66 20 4e 61 6d 65 20 28 61 73 20 ST, of Name (as
9970: 55 4e 52 45 53 2d 4e 41 4d 45 29 2c 20 56 61 6c UNRES-NAME), Val
9980: 75 65 20 28 61 73 20 73 74 72 69 6e 67 29 0a 3b ue (as string).;
9990: 20 70 61 69 72 73 2e 20 54 68 65 20 63 75 72 72 pairs. The curr
99a0: 65 6e 74 20 63 68 61 72 61 63 74 65 72 20 6f 6e ent character on
99b0: 20 74 68 65 20 50 4f 52 54 20 69 73 20 61 20 6e the PORT is a n
99c0: 6f 6e 2d 77 68 69 74 65 73 70 61 63 65 20 63 68 on-whitespace ch
99d0: 61 72 61 63 74 65 72 0a 3b 20 74 68 61 74 20 69 aracter.; that i
99e0: 73 20 6e 6f 74 20 61 6e 20 6e 63 6e 61 6d 65 2d s not an ncname-
99f0: 73 74 61 72 74 69 6e 67 20 63 68 61 72 61 63 74 starting charact
9a00: 65 72 2e 0a 3b 0a 3b 20 4e 6f 74 65 20 74 68 65 er..;.; Note the
9a10: 20 66 6f 6c 6c 6f 77 69 6e 67 20 72 75 6c 65 73 following rules
9a20: 20 74 6f 20 6b 65 65 70 20 69 6e 20 6d 69 6e 64 to keep in mind
9a30: 20 77 68 65 6e 20 72 65 61 64 69 6e 67 20 61 6e when reading an
9a40: 20 27 41 74 74 56 61 6c 75 65 27 0a 3b 20 22 42 'AttValue'.; "B
9a50: 65 66 6f 72 65 20 74 68 65 20 76 61 6c 75 65 20 efore the value
9a60: 6f 66 20 61 6e 20 61 74 74 72 69 62 75 74 65 20 of an attribute
9a70: 69 73 20 70 61 73 73 65 64 20 74 6f 20 74 68 65 is passed to the
9a80: 20 61 70 70 6c 69 63 61 74 69 6f 6e 0a 3b 20 6f application.; o
9a90: 72 20 63 68 65 63 6b 65 64 20 66 6f 72 20 76 61 r checked for va
9aa0: 6c 69 64 69 74 79 2c 20 74 68 65 20 58 4d 4c 20 lidity, the XML
9ab0: 70 72 6f 63 65 73 73 6f 72 20 6d 75 73 74 20 6e processor must n
9ac0: 6f 72 6d 61 6c 69 7a 65 20 69 74 20 61 73 20 66 ormalize it as f
9ad0: 6f 6c 6c 6f 77 73 3a 20 0a 3b 20 2d 20 61 20 63 ollows: .; - a c
9ae0: 68 61 72 61 63 74 65 72 20 72 65 66 65 72 65 6e haracter referen
9af0: 63 65 20 69 73 20 70 72 6f 63 65 73 73 65 64 20 ce is processed
9b00: 62 79 20 61 70 70 65 6e 64 69 6e 67 20 74 68 65 by appending the
9b10: 20 72 65 66 65 72 65 6e 63 65 64 0a 3b 20 20 20 referenced.;
9b20: 63 68 61 72 61 63 74 65 72 20 74 6f 20 74 68 65 character to the
9b30: 20 61 74 74 72 69 62 75 74 65 20 76 61 6c 75 65 attribute value
9b40: 20 0a 3b 20 2d 20 61 6e 20 65 6e 74 69 74 79 20 .; - an entity
9b50: 72 65 66 65 72 65 6e 63 65 20 69 73 20 70 72 6f reference is pro
9b60: 63 65 73 73 65 64 20 62 79 20 72 65 63 75 72 73 cessed by recurs
9b70: 69 76 65 6c 79 20 70 72 6f 63 65 73 73 69 6e 67 ively processing
9b80: 20 74 68 65 0a 3b 20 20 20 72 65 70 6c 61 63 65 the.; replace
9b90: 6d 65 6e 74 20 74 65 78 74 20 6f 66 20 74 68 65 ment text of the
9ba0: 20 65 6e 74 69 74 79 20 5b 73 65 65 20 45 4e 54 entity [see ENT
9bb0: 49 54 49 45 53 5d 0a 3b 20 20 20 5b 6e 61 6d 65 ITIES].; [name
9bc0: 64 20 65 6e 74 69 74 69 65 73 20 61 6d 70 20 6c d entities amp l
9bd0: 74 20 67 74 20 71 75 6f 74 20 61 70 6f 73 20 61 t gt quot apos a
9be0: 72 65 20 61 73 73 75 6d 65 64 20 70 72 65 2d 64 re assumed pre-d
9bf0: 65 63 6c 61 72 65 64 5d 0a 3b 20 2d 20 61 20 77 eclared].; - a w
9c00: 68 69 74 65 73 70 61 63 65 20 63 68 61 72 61 63 hitespace charac
9c10: 74 65 72 20 28 23 78 32 30 2c 20 23 78 44 2c 20 ter (#x20, #xD,
9c20: 23 78 41 2c 20 23 78 39 29 20 69 73 20 70 72 6f #xA, #x9) is pro
9c30: 63 65 73 73 65 64 20 62 79 20 61 70 70 65 6e 64 cessed by append
9c40: 69 6e 67 20 23 78 32 30 0a 3b 20 20 20 74 6f 20 ing #x20.; to
9c50: 74 68 65 20 6e 6f 72 6d 61 6c 69 7a 65 64 20 76 the normalized v
9c60: 61 6c 75 65 2c 20 65 78 63 65 70 74 20 74 68 61 alue, except tha
9c70: 74 20 6f 6e 6c 79 20 61 20 73 69 6e 67 6c 65 20 t only a single
9c80: 23 78 32 30 20 69 73 20 61 70 70 65 6e 64 65 64 #x20 is appended
9c90: 20 66 6f 72 20 61 0a 3b 20 20 20 22 23 78 44 23 for a.; "#xD#
9ca0: 78 41 22 20 73 65 71 75 65 6e 63 65 20 74 68 61 xA" sequence tha
9cb0: 74 20 69 73 20 70 61 72 74 20 6f 66 20 61 6e 20 t is part of an
9cc0: 65 78 74 65 72 6e 61 6c 20 70 61 72 73 65 64 20 external parsed
9cd0: 65 6e 74 69 74 79 20 6f 72 20 74 68 65 0a 3b 20 entity or the.;
9ce0: 20 20 6c 69 74 65 72 61 6c 20 65 6e 74 69 74 79 literal entity
9cf0: 20 76 61 6c 75 65 20 6f 66 20 61 6e 20 69 6e 74 value of an int
9d00: 65 72 6e 61 6c 20 70 61 72 73 65 64 20 65 6e 74 ernal parsed ent
9d10: 69 74 79 20 0a 3b 20 2d 20 6f 74 68 65 72 20 63 ity .; - other c
9d20: 68 61 72 61 63 74 65 72 73 20 61 72 65 20 70 72 haracters are pr
9d30: 6f 63 65 73 73 65 64 20 62 79 20 61 70 70 65 6e ocessed by appen
9d40: 64 69 6e 67 20 74 68 65 6d 20 74 6f 20 74 68 65 ding them to the
9d50: 20 6e 6f 72 6d 61 6c 69 7a 65 64 20 76 61 6c 75 normalized valu
9d60: 65 20 22 0a 3b 0a 3b 0a 3b 20 46 61 75 6c 74 73 e ".;.;.; Faults
9d70: 20 64 65 74 65 63 74 65 64 3a 0a 3b 09 57 46 43 detected:.;.WFC
9d80: 3a 20 58 4d 4c 2d 53 70 65 63 2e 68 74 6d 6c 23 : XML-Spec.html#
9d90: 43 6c 65 61 6e 41 74 74 72 56 61 6c 73 0a 3b 09 CleanAttrVals.;.
9da0: 57 46 43 3a 20 58 4d 4c 2d 53 70 65 63 2e 68 74 WFC: XML-Spec.ht
9db0: 6d 6c 23 75 6e 69 71 61 74 74 73 70 65 63 0a 0a ml#uniqattspec..
9dc0: 28 64 65 66 69 6e 65 20 73 73 61 78 3a 72 65 61 (define ssax:rea
9dd0: 64 2d 61 74 74 72 69 62 75 74 65 73 20 20 3b 20 d-attributes ;
9de0: 73 73 61 78 3a 72 65 61 64 2d 61 74 74 72 69 62 ssax:read-attrib
9df0: 75 74 65 73 20 70 6f 72 74 20 65 6e 74 69 74 69 utes port entiti
9e00: 65 73 0a 20 28 6c 65 74 20 28 28 76 61 6c 75 65 es. (let ((value
9e10: 2d 64 65 6c 69 6d 65 74 65 72 73 20 28 61 70 70 -delimeters (app
9e20: 65 6e 64 20 73 73 61 78 3a 53 2d 63 68 61 72 73 end ssax:S-chars
9e30: 20 27 28 23 5c 3c 20 23 5c 26 29 29 29 29 0a 09 '(#\< #\&))))..
9e40: 09 3b 20 52 65 61 64 20 74 68 65 20 41 74 74 56 .; Read the AttV
9e50: 61 6c 75 65 20 66 72 6f 6d 20 74 68 65 20 50 4f alue from the PO
9e60: 52 54 20 75 70 20 74 6f 20 74 68 65 20 64 65 6c RT up to the del
9e70: 69 6d 69 74 65 72 0a 09 09 3b 20 28 77 68 69 63 imiter...; (whic
9e80: 68 20 63 61 6e 20 62 65 20 61 20 73 69 6e 67 6c h can be a singl
9e90: 65 20 6f 72 20 64 6f 75 62 6c 65 2d 71 75 6f 74 e or double-quot
9ea0: 65 20 63 68 61 72 61 63 74 65 72 2c 0a 09 09 3b e character,...;
9eb0: 20 6f 72 20 65 76 65 6e 20 61 20 73 79 6d 62 6f or even a symbo
9ec0: 6c 20 2a 65 6f 66 2a 29 0a 09 09 3b 20 27 70 72 l *eof*)...; 'pr
9ed0: 65 76 2d 66 72 61 67 6d 65 6e 74 73 27 20 69 73 ev-fragments' is
9ee0: 20 74 68 65 20 6c 69 73 74 20 6f 66 20 73 74 72 the list of str
9ef0: 69 6e 67 20 66 72 61 67 6d 65 6e 74 73 2c 20 61 ing fragments, a
9f00: 63 63 75 6d 75 6c 61 74 65 64 0a 09 09 3b 20 73 ccumulated...; s
9f10: 6f 20 66 61 72 2c 20 69 6e 20 72 65 76 65 72 73 o far, in revers
9f20: 65 20 6f 72 64 65 72 2e 0a 09 09 3b 20 52 65 74 e order....; Ret
9f30: 75 72 6e 20 74 68 65 20 6c 69 73 74 20 6f 66 20 urn the list of
9f40: 66 72 61 67 6d 65 6e 74 73 20 77 69 74 68 20 6e fragments with n
9f50: 65 77 6c 79 20 72 65 61 64 20 66 72 61 67 6d 65 ewly read fragme
9f60: 6e 74 73 0a 09 09 3b 20 70 72 65 70 65 6e 64 65 nts...; prepende
9f70: 64 2e 0a 20 20 28 64 65 66 69 6e 65 20 28 72 65 d.. (define (re
9f80: 61 64 2d 61 74 74 72 69 62 2d 76 61 6c 75 65 20 ad-attrib-value
9f90: 64 65 6c 69 6d 69 74 65 72 20 70 6f 72 74 20 65 delimiter port e
9fa0: 6e 74 69 74 69 65 73 20 70 72 65 76 2d 66 72 61 ntities prev-fra
9fb0: 67 6d 65 6e 74 73 29 0a 20 20 20 20 28 6c 65 74 gments). (let
9fc0: 2a 20 28 28 6e 65 77 2d 66 72 61 67 6d 65 6e 74 * ((new-fragment
9fd0: 73 0a 09 20 20 20 20 28 63 6f 6e 73 20 28 6e 65 s.. (cons (ne
9fe0: 78 74 2d 74 6f 6b 65 6e 20 27 28 29 20 28 63 6f xt-token '() (co
9ff0: 6e 73 20 64 65 6c 69 6d 69 74 65 72 20 76 61 6c ns delimiter val
a000: 75 65 2d 64 65 6c 69 6d 65 74 65 72 73 29 0a 09 ue-delimeters)..
a010: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 . "
a020: 58 4d 4c 20 5b 31 30 5d 22 20 70 6f 72 74 29 0a XML [10]" port).
a030: 09 20 20 20 20 20 70 72 65 76 2d 66 72 61 67 6d . prev-fragm
a040: 65 6e 74 73 29 29 0a 09 20 20 20 28 63 74 65 72 ents)).. (cter
a050: 6d 20 28 72 65 61 64 2d 63 68 61 72 20 70 6f 72 m (read-char por
a060: 74 29 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 t))). (cond
a070: 0a 09 28 28 6f 72 20 28 65 6f 66 2d 6f 62 6a 65 ..((or (eof-obje
a080: 63 74 3f 20 63 74 65 72 6d 29 20 28 65 71 76 3f ct? cterm) (eqv?
a090: 20 63 74 65 72 6d 20 64 65 6c 69 6d 69 74 65 72 cterm delimiter
a0a0: 29 29 0a 09 20 20 6e 65 77 2d 66 72 61 67 6d 65 )).. new-fragme
a0b0: 6e 74 73 29 0a 09 28 28 65 71 76 3f 20 63 74 65 nts)..((eqv? cte
a0c0: 72 6d 20 63 68 61 72 2d 72 65 74 75 72 6e 29 09 rm char-return).
a0d0: 3b 20 74 72 65 61 74 20 61 20 43 52 20 61 6e 64 ; treat a CR and
a0e0: 20 43 52 4c 46 20 61 73 20 61 20 4c 46 0a 09 20 CRLF as a LF..
a0f0: 20 28 69 66 20 28 65 71 76 3f 20 28 70 65 65 6b (if (eqv? (peek
a100: 2d 63 68 61 72 20 70 6f 72 74 29 20 23 5c 6e 65 -char port) #\ne
a110: 77 6c 69 6e 65 29 20 28 72 65 61 64 2d 63 68 61 wline) (read-cha
a120: 72 20 70 6f 72 74 29 29 0a 09 20 20 28 72 65 61 r port)).. (rea
a130: 64 2d 61 74 74 72 69 62 2d 76 61 6c 75 65 20 64 d-attrib-value d
a140: 65 6c 69 6d 69 74 65 72 20 70 6f 72 74 20 65 6e elimiter port en
a150: 74 69 74 69 65 73 0a 09 20 20 20 20 20 20 20 20 tities..
a160: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
a170: 6e 73 20 22 20 22 20 6e 65 77 2d 66 72 61 67 6d ns " " new-fragm
a180: 65 6e 74 73 29 29 29 0a 09 28 28 6d 65 6d 76 20 ents)))..((memv
a190: 63 74 65 72 6d 20 73 73 61 78 3a 53 2d 63 68 61 cterm ssax:S-cha
a1a0: 72 73 29 0a 09 20 20 28 72 65 61 64 2d 61 74 74 rs).. (read-att
a1b0: 72 69 62 2d 76 61 6c 75 65 20 64 65 6c 69 6d 69 rib-value delimi
a1c0: 74 65 72 20 70 6f 72 74 20 65 6e 74 69 74 69 65 ter port entitie
a1d0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 20 20 20 s..
a1e0: 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 22 20 (cons "
a1f0: 22 20 6e 65 77 2d 66 72 61 67 6d 65 6e 74 73 29 " new-fragments)
a200: 29 29 0a 09 28 28 65 71 76 3f 20 63 74 65 72 6d ))..((eqv? cterm
a210: 20 23 5c 26 29 0a 09 20 20 28 63 6f 6e 64 0a 09 #\&).. (cond..
a220: 20 20 20 20 28 28 65 71 76 3f 20 28 70 65 65 6b ((eqv? (peek
a230: 2d 63 68 61 72 20 70 6f 72 74 29 20 23 5c 23 29 -char port) #\#)
a240: 0a 09 20 20 20 20 20 20 28 72 65 61 64 2d 63 68 .. (read-ch
a250: 61 72 20 70 6f 72 74 29 0a 09 20 20 20 20 20 20 ar port)..
a260: 28 72 65 61 64 2d 61 74 74 72 69 62 2d 76 61 6c (read-attrib-val
a270: 75 65 20 64 65 6c 69 6d 69 74 65 72 20 70 6f 72 ue delimiter por
a280: 74 20 65 6e 74 69 74 69 65 73 0a 09 09 28 63 6f t entities...(co
a290: 6e 73 20 28 73 74 72 69 6e 67 20 28 73 73 61 78 ns (string (ssax
a2a0: 3a 72 65 61 64 2d 63 68 61 72 2d 72 65 66 20 70 :read-char-ref p
a2b0: 6f 72 74 29 29 20 6e 65 77 2d 66 72 61 67 6d 65 ort)) new-fragme
a2c0: 6e 74 73 29 29 29 0a 09 20 20 20 20 28 65 6c 73 nts))).. (els
a2d0: 65 0a 09 20 20 20 20 20 20 28 72 65 61 64 2d 61 e.. (read-a
a2e0: 74 74 72 69 62 2d 76 61 6c 75 65 20 64 65 6c 69 ttrib-value deli
a2f0: 6d 69 74 65 72 20 70 6f 72 74 20 65 6e 74 69 74 miter port entit
a300: 69 65 73 0a 09 09 28 72 65 61 64 2d 6e 61 6d 65 ies...(read-name
a310: 64 2d 65 6e 74 69 74 79 20 70 6f 72 74 20 65 6e d-entity port en
a320: 74 69 74 69 65 73 20 6e 65 77 2d 66 72 61 67 6d tities new-fragm
a330: 65 6e 74 73 29 29 29 29 29 0a 09 28 65 6c 73 65 ents)))))..(else
a340: 20 28 70 61 72 73 65 72 2d 65 72 72 6f 72 20 70 (parser-error p
a350: 6f 72 74 20 22 5b 43 6c 65 61 6e 41 74 74 72 56 ort "[CleanAttrV
a360: 61 6c 73 5d 20 62 72 6f 6b 65 6e 22 29 29 29 29 als] broken"))))
a370: 29 0a 0a 09 09 3b 20 77 65 20 68 61 76 65 20 72 )....; we have r
a380: 65 61 64 20 22 26 22 20 74 68 61 74 20 69 6e 74 ead "&" that int
a390: 72 6f 64 75 63 65 73 20 61 20 6e 61 6d 65 64 20 roduces a named
a3a0: 65 6e 74 69 74 79 20 72 65 66 65 72 65 6e 63 65 entity reference
a3b0: 2e 0a 09 09 3b 20 72 65 61 64 20 74 68 69 73 20 ....; read this
a3c0: 72 65 66 65 72 65 6e 63 65 20 61 6e 64 20 72 65 reference and re
a3d0: 74 75 72 6e 20 74 68 65 20 72 65 73 75 6c 74 20 turn the result
a3e0: 6f 66 0a 09 09 3b 20 6e 6f 72 6d 61 6c 69 7a 69 of...; normalizi
a3f0: 6e 67 20 6f 66 20 74 68 65 20 63 6f 72 72 65 73 ng of the corres
a400: 70 6f 6e 64 69 6e 67 20 73 74 72 69 6e 67 0a 09 ponding string..
a410: 09 3b 20 28 74 68 61 74 20 69 73 2c 20 72 65 61 .; (that is, rea
a420: 64 2d 61 74 74 72 69 62 2d 76 61 6c 75 65 20 69 d-attrib-value i
a430: 73 20 61 70 70 6c 69 65 64 20 74 6f 20 74 68 65 s applied to the
a440: 20 72 65 70 6c 61 63 65 6d 65 6e 74 0a 09 09 3b replacement...;
a450: 20 74 65 78 74 20 6f 66 20 74 68 65 20 65 6e 74 text of the ent
a460: 69 74 79 29 0a 09 09 3b 20 54 68 65 20 63 75 72 ity)...; The cur
a470: 72 65 6e 74 20 70 6f 73 69 74 69 6f 6e 20 77 69 rent position wi
a480: 6c 6c 20 62 65 20 61 66 74 65 72 20 22 3b 22 20 ll be after ";"
a490: 74 68 61 74 20 74 65 72 6d 69 6e 61 74 65 73 0a that terminates.
a4a0: 09 09 3b 20 74 68 65 20 65 6e 74 69 74 79 20 72 ..; the entity r
a4b0: 65 66 65 72 65 6e 63 65 0a 20 20 28 64 65 66 69 eference. (defi
a4c0: 6e 65 20 28 72 65 61 64 2d 6e 61 6d 65 64 2d 65 ne (read-named-e
a4d0: 6e 74 69 74 79 20 70 6f 72 74 20 65 6e 74 69 74 ntity port entit
a4e0: 69 65 73 20 66 72 61 67 6d 65 6e 74 73 29 0a 20 ies fragments).
a4f0: 20 20 20 28 6c 65 74 20 28 28 6e 61 6d 65 20 28 (let ((name (
a500: 73 73 61 78 3a 72 65 61 64 2d 4e 43 4e 61 6d 65 ssax:read-NCName
a510: 20 70 6f 72 74 29 29 29 0a 20 20 20 20 20 20 28 port))). (
a520: 61 73 73 65 72 74 2d 63 75 72 72 2d 63 68 61 72 assert-curr-char
a530: 20 27 28 23 5c 3b 29 20 22 58 4d 4c 20 5b 36 38 '(#\;) "XML [68
a540: 5d 22 20 70 6f 72 74 29 0a 20 20 20 20 20 20 28 ]" port). (
a550: 73 73 61 78 3a 68 61 6e 64 6c 65 2d 70 61 72 73 ssax:handle-pars
a560: 65 64 2d 65 6e 74 69 74 79 20 70 6f 72 74 20 6e ed-entity port n
a570: 61 6d 65 20 65 6e 74 69 74 69 65 73 0a 09 28 6c ame entities..(l
a580: 61 6d 62 64 61 20 28 70 6f 72 74 20 65 6e 74 69 ambda (port enti
a590: 74 69 65 73 20 66 72 61 67 6d 65 6e 74 73 29 0a ties fragments).
a5a0: 09 20 20 28 72 65 61 64 2d 61 74 74 72 69 62 2d . (read-attrib-
a5b0: 76 61 6c 75 65 20 27 2a 65 6f 66 2a 20 70 6f 72 value '*eof* por
a5c0: 74 20 65 6e 74 69 74 69 65 73 20 66 72 61 67 6d t entities fragm
a5d0: 65 6e 74 73 29 29 0a 09 28 6c 61 6d 62 64 61 20 ents))..(lambda
a5e0: 28 73 74 72 31 20 73 74 72 32 20 66 72 61 67 6d (str1 str2 fragm
a5f0: 65 6e 74 73 29 0a 09 20 20 28 69 66 20 28 65 71 ents).. (if (eq
a600: 75 61 6c 3f 20 22 22 20 73 74 72 32 29 20 28 63 ual? "" str2) (c
a610: 6f 6e 73 20 73 74 72 31 20 66 72 61 67 6d 65 6e ons str1 fragmen
a620: 74 73 29 0a 09 20 20 20 20 20 20 28 63 6f 6e 73 ts).. (cons
a630: 2a 20 73 74 72 32 20 73 74 72 31 20 66 72 61 67 * str2 str1 frag
a640: 6d 65 6e 74 73 29 29 29 0a 09 66 72 61 67 6d 65 ments)))..fragme
a650: 6e 74 73 29 29 29 0a 0a 20 20 28 6c 61 6d 62 64 nts))).. (lambd
a660: 61 20 28 70 6f 72 74 20 65 6e 74 69 74 69 65 73 a (port entities
a670: 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ). (let loop
a680: 28 28 61 74 74 72 2d 6c 69 73 74 20 28 6d 61 6b ((attr-list (mak
a690: 65 2d 65 6d 70 74 79 2d 61 74 74 6c 69 73 74 29 e-empty-attlist)
a6a0: 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f )). (if (no
a6b0: 74 20 28 73 73 61 78 3a 6e 63 6e 61 6d 65 2d 73 t (ssax:ncname-s
a6c0: 74 61 72 74 69 6e 67 2d 63 68 61 72 3f 20 28 73 tarting-char? (s
a6d0: 73 61 78 3a 73 6b 69 70 2d 53 20 70 6f 72 74 29 sax:skip-S port)
a6e0: 29 29 20 61 74 74 72 2d 6c 69 73 74 0a 09 20 20 )) attr-list..
a6f0: 28 6c 65 74 20 28 28 6e 61 6d 65 20 28 73 73 61 (let ((name (ssa
a700: 78 3a 72 65 61 64 2d 51 4e 61 6d 65 20 70 6f 72 x:read-QName por
a710: 74 29 29 29 0a 09 20 20 20 20 28 73 73 61 78 3a t))).. (ssax:
a720: 73 6b 69 70 2d 53 20 70 6f 72 74 29 0a 09 20 20 skip-S port)..
a730: 20 20 28 61 73 73 65 72 74 2d 63 75 72 72 2d 63 (assert-curr-c
a740: 68 61 72 20 27 28 23 5c 3d 29 20 22 58 4d 4c 20 har '(#\=) "XML
a750: 5b 32 35 5d 22 20 70 6f 72 74 29 0a 09 20 20 20 [25]" port)..
a760: 20 28 73 73 61 78 3a 73 6b 69 70 2d 53 20 70 6f (ssax:skip-S po
a770: 72 74 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 rt).. (let ((
a780: 64 65 6c 69 6d 69 74 65 72 20 0a 09 09 20 20 20 delimiter ...
a790: 28 61 73 73 65 72 74 2d 63 75 72 72 2d 63 68 61 (assert-curr-cha
a7a0: 72 20 27 28 23 5c 27 20 23 5c 22 20 29 20 22 58 r '(#\' #\" ) "X
a7b0: 4d 4c 20 5b 31 30 5d 22 20 70 6f 72 74 29 29 29 ML [10]" port)))
a7c0: 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 0a 09 .. (loop ..
a7d0: 20 20 20 20 20 20 20 28 6f 72 20 28 61 74 74 6c (or (attl
a7e0: 69 73 74 2d 61 64 64 20 61 74 74 72 2d 6c 69 73 ist-add attr-lis
a7f0: 74 20 0a 09 09 20 20 20 20 20 28 63 6f 6e 73 20 t ... (cons
a800: 6e 61 6d 65 20 0a 09 09 09 20 20 20 28 73 74 72 name .... (str
a810: 69 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 65 2d ing-concatenate-
a820: 72 65 76 65 72 73 65 2f 73 68 61 72 65 64 0a 09 reverse/shared..
a830: 09 09 20 20 20 20 20 28 72 65 61 64 2d 61 74 74 .. (read-att
a840: 72 69 62 2d 76 61 6c 75 65 20 64 65 6c 69 6d 69 rib-value delimi
a850: 74 65 72 20 70 6f 72 74 20 65 6e 74 69 74 69 65 ter port entitie
a860: 73 0a 09 09 09 09 09 09 20 20 20 20 20 20 27 28 s....... '(
a870: 29 29 29 29 29 0a 09 09 20 20 20 28 70 61 72 73 )))))... (pars
a880: 65 72 2d 65 72 72 6f 72 20 70 6f 72 74 20 22 5b er-error port "[
a890: 75 6e 69 71 61 74 74 73 70 65 63 5d 20 62 72 6f uniqattspec] bro
a8a0: 6b 65 6e 20 66 6f 72 20 22 20 6e 61 6d 65 29 29 ken for " name))
a8b0: 29 29 29 29 29 29 0a 29 29 0a 0a 0a 3b 20 73 73 )))))).))...; ss
a8c0: 61 78 3a 72 65 73 6f 6c 76 65 2d 6e 61 6d 65 20 ax:resolve-name
a8d0: 50 4f 52 54 20 55 4e 52 45 53 2d 4e 41 4d 45 20 PORT UNRES-NAME
a8e0: 4e 41 4d 45 53 50 41 43 45 53 20 61 70 70 6c 79 NAMESPACES apply
a8f0: 2d 64 65 66 61 75 6c 74 2d 6e 73 3f 0a 3b 0a 3b -default-ns?.;.;
a900: 20 43 6f 6e 76 65 72 74 20 61 6e 20 55 4e 52 45 Convert an UNRE
a910: 53 2d 4e 41 4d 45 20 74 6f 20 61 20 52 45 53 2d S-NAME to a RES-
a920: 4e 41 4d 45 20 67 69 76 65 6e 20 74 68 65 20 61 NAME given the a
a930: 70 70 72 6f 70 72 69 61 74 65 20 4e 41 4d 45 53 ppropriate NAMES
a940: 50 41 43 45 53 0a 3b 20 64 65 63 6c 61 72 61 74 PACES.; declarat
a950: 69 6f 6e 73 2e 0a 3b 20 74 68 65 20 6c 61 73 74 ions..; the last
a960: 20 70 61 72 61 6d 65 74 65 72 20 61 70 70 6c 79 parameter apply
a970: 2d 64 65 66 61 75 6c 74 2d 6e 73 3f 20 64 65 74 -default-ns? det
a980: 65 72 6d 69 6e 65 73 20 69 66 20 74 68 65 20 64 ermines if the d
a990: 65 66 61 75 6c 74 0a 3b 20 6e 61 6d 65 73 70 61 efault.; namespa
a9a0: 63 65 20 61 70 70 6c 69 65 73 20 28 66 6f 72 20 ce applies (for
a9b0: 69 6e 73 74 61 6e 63 65 2c 20 69 74 20 64 6f 65 instance, it doe
a9c0: 73 20 6e 6f 74 20 66 6f 72 20 61 74 74 72 69 62 s not for attrib
a9d0: 75 74 65 20 6e 61 6d 65 73 29 0a 3b 0a 3b 20 50 ute names).;.; P
a9e0: 65 72 20 52 45 43 2d 78 6d 6c 2d 6e 61 6d 65 73 er REC-xml-names
a9f0: 2f 23 6e 73 63 2d 4e 53 44 65 63 6c 61 72 65 64 /#nsc-NSDeclared
aa00: 2c 20 22 78 6d 6c 22 20 70 72 65 66 69 78 20 69 , "xml" prefix i
aa10: 73 20 63 6f 6e 73 69 64 65 72 65 64 20 70 72 65 s considered pre
aa20: 2d 64 65 63 6c 61 72 65 64 0a 3b 20 61 6e 64 20 -declared.; and
aa30: 62 6f 75 6e 64 20 74 6f 20 74 68 65 20 6e 61 6d bound to the nam
aa40: 65 73 70 61 63 65 20 6e 61 6d 65 20 22 68 74 74 espace name "htt
aa50: 70 3a 2f 2f 77 77 77 2e 77 33 2e 6f 72 67 2f 58 p://www.w3.org/X
aa60: 4d 4c 2f 31 39 39 38 2f 6e 61 6d 65 73 70 61 63 ML/1998/namespac
aa70: 65 22 2e 0a 3b 0a 3b 20 54 68 69 73 20 70 72 6f e"..;.; This pro
aa80: 63 65 64 75 72 65 20 74 65 73 74 73 20 66 6f 72 cedure tests for
aa90: 20 74 68 65 20 6e 61 6d 65 73 70 61 63 65 20 63 the namespace c
aaa0: 6f 6e 73 74 72 61 69 6e 74 73 3a 0a 3b 20 68 74 onstraints:.; ht
aab0: 74 70 3a 2f 2f 77 77 77 2e 77 33 2e 6f 72 67 2f tp://www.w3.org/
aac0: 54 52 2f 52 45 43 2d 78 6d 6c 2d 6e 61 6d 65 73 TR/REC-xml-names
aad0: 2f 23 6e 73 63 2d 4e 53 44 65 63 6c 61 72 65 64 /#nsc-NSDeclared
aae0: 0a 0a 28 64 65 66 69 6e 65 20 28 73 73 61 78 3a ..(define (ssax:
aaf0: 72 65 73 6f 6c 76 65 2d 6e 61 6d 65 20 70 6f 72 resolve-name por
ab00: 74 20 75 6e 72 65 73 2d 6e 61 6d 65 20 6e 61 6d t unres-name nam
ab10: 65 73 70 61 63 65 73 20 61 70 70 6c 79 2d 64 65 espaces apply-de
ab20: 66 61 75 6c 74 2d 6e 73 3f 29 0a 20 20 28 63 6f fault-ns?). (co
ab30: 6e 64 0a 20 20 20 28 28 70 61 69 72 3f 20 75 6e nd. ((pair? un
ab40: 72 65 73 2d 6e 61 6d 65 29 09 09 3b 20 69 74 27 res-name)..; it'
ab50: 73 20 61 20 51 4e 41 4d 45 0a 20 20 20 20 28 63 s a QNAME. (c
ab60: 6f 6e 73 20 0a 20 20 20 20 20 28 63 6f 6e 64 0a ons . (cond.
ab70: 20 20 20 20 20 28 28 61 73 73 71 20 28 63 61 72 ((assq (car
ab80: 20 75 6e 72 65 73 2d 6e 61 6d 65 29 20 6e 61 6d unres-name) nam
ab90: 65 73 70 61 63 65 73 29 20 3d 3e 20 63 61 64 72 espaces) => cadr
aba0: 29 0a 20 20 20 20 20 28 28 65 71 3f 20 28 63 61 ). ((eq? (ca
abb0: 72 20 75 6e 72 65 73 2d 6e 61 6d 65 29 20 73 73 r unres-name) ss
abc0: 61 78 3a 50 72 65 66 69 78 2d 58 4d 4c 29 20 73 ax:Prefix-XML) s
abd0: 73 61 78 3a 50 72 65 66 69 78 2d 58 4d 4c 29 0a sax:Prefix-XML).
abe0: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
abf0: 20 28 70 61 72 73 65 72 2d 65 72 72 6f 72 20 70 (parser-error p
ac00: 6f 72 74 20 22 5b 6e 73 63 2d 4e 53 44 65 63 6c ort "[nsc-NSDecl
ac10: 61 72 65 64 5d 20 62 72 6f 6b 65 6e 3b 20 70 72 ared] broken; pr
ac20: 65 66 69 78 20 22 20 28 63 61 72 20 75 6e 72 65 efix " (car unre
ac30: 73 2d 6e 61 6d 65 29 29 29 29 0a 20 20 20 20 20 s-name)))).
ac40: 28 63 64 72 20 75 6e 72 65 73 2d 6e 61 6d 65 29 (cdr unres-name)
ac50: 29 29 0a 20 20 20 28 61 70 70 6c 79 2d 64 65 66 )). (apply-def
ac60: 61 75 6c 74 2d 6e 73 3f 09 09 3b 20 44 6f 20 61 ault-ns?..; Do a
ac70: 70 70 6c 79 20 74 68 65 20 64 65 66 61 75 6c 74 pply the default
ac80: 20 6e 61 6d 65 73 70 61 63 65 2c 20 69 66 20 61 namespace, if a
ac90: 6e 79 0a 20 20 20 20 28 6c 65 74 20 28 28 64 65 ny. (let ((de
aca0: 66 61 75 6c 74 2d 6e 73 20 28 61 73 73 71 20 27 fault-ns (assq '
acb0: 2a 44 45 46 41 55 4c 54 2a 20 6e 61 6d 65 73 70 *DEFAULT* namesp
acc0: 61 63 65 73 29 29 29 0a 20 20 20 20 20 20 28 69 aces))). (i
acd0: 66 20 28 61 6e 64 20 64 65 66 61 75 6c 74 2d 6e f (and default-n
ace0: 73 20 28 63 61 64 72 20 64 65 66 61 75 6c 74 2d s (cadr default-
acf0: 6e 73 29 29 0a 09 20 20 28 63 6f 6e 73 20 28 63 ns)).. (cons (c
ad00: 61 64 72 20 64 65 66 61 75 6c 74 2d 6e 73 29 20 adr default-ns)
ad10: 75 6e 72 65 73 2d 6e 61 6d 65 29 0a 09 20 20 75 unres-name).. u
ad20: 6e 72 65 73 2d 6e 61 6d 65 29 29 29 09 09 3b 20 nres-name)))..;
ad30: 6e 6f 20 64 65 66 61 75 6c 74 20 6e 61 6d 65 73 no default names
ad40: 70 61 63 65 20 64 65 63 6c 61 72 65 64 0a 20 20 pace declared.
ad50: 20 28 65 6c 73 65 20 75 6e 72 65 73 2d 6e 61 6d (else unres-nam
ad60: 65 29 29 29 09 09 3b 20 6e 6f 20 70 72 65 66 69 e)))..; no prefi
ad70: 78 2c 20 64 6f 6e 27 74 20 61 70 70 6c 79 20 74 x, don't apply t
ad80: 68 65 20 64 65 66 61 75 6c 74 2d 6e 73 09 20 20 he default-ns.
ad90: 20 0a 09 20 20 0a 0a 3b 20 70 72 6f 63 65 64 75 .. ..; procedu
ada0: 72 65 2b 3a 09 73 73 61 78 3a 75 72 69 2d 73 74 re+:.ssax:uri-st
adb0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 55 52 49 ring->symbol URI
adc0: 2d 53 54 52 0a 3b 20 43 6f 6e 76 65 72 74 20 61 -STR.; Convert a
add0: 20 55 52 49 2d 53 54 52 20 74 6f 20 61 6e 20 61 URI-STR to an a
ade0: 70 70 72 6f 70 72 69 61 74 65 20 73 79 6d 62 6f ppropriate symbo
adf0: 6c 0a 28 64 65 66 69 6e 65 20 28 73 73 61 78 3a l.(define (ssax:
ae00: 75 72 69 2d 73 74 72 69 6e 67 2d 3e 73 79 6d 62 uri-string->symb
ae10: 6f 6c 20 75 72 69 2d 73 74 72 29 0a 20 20 28 73 ol uri-str). (s
ae20: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 75 72 tring->symbol ur
ae30: 69 2d 73 74 72 29 29 0a 0a 3b 20 70 72 6f 63 65 i-str))..; proce
ae40: 64 75 72 65 2b 3a 09 73 73 61 78 3a 63 6f 6d 70 dure+:.ssax:comp
ae50: 6c 65 74 65 2d 73 74 61 72 74 2d 74 61 67 20 54 lete-start-tag T
ae60: 41 47 20 50 4f 52 54 20 45 4c 45 4d 53 20 45 4e AG PORT ELEMS EN
ae70: 54 49 54 49 45 53 20 4e 41 4d 45 53 50 41 43 45 TITIES NAMESPACE
ae80: 53 0a 3b 0a 3b 20 54 68 69 73 20 70 72 6f 63 65 S.;.; This proce
ae90: 64 75 72 65 20 69 73 20 74 6f 20 63 6f 6d 70 6c dure is to compl
aea0: 65 74 65 20 70 61 72 73 69 6e 67 20 6f 66 20 61 ete parsing of a
aeb0: 20 73 74 61 72 74 2d 74 61 67 20 6d 61 72 6b 75 start-tag marku
aec0: 70 2e 20 54 68 65 0a 3b 20 70 72 6f 63 65 64 75 p. The.; procedu
aed0: 72 65 20 6d 75 73 74 20 62 65 20 63 61 6c 6c 65 re must be calle
aee0: 64 20 61 66 74 65 72 20 74 68 65 20 73 74 61 72 d after the star
aef0: 74 20 74 61 67 20 74 6f 6b 65 6e 20 68 61 73 20 t tag token has
af00: 62 65 65 6e 0a 3b 20 72 65 61 64 2e 20 54 41 47 been.; read. TAG
af10: 20 69 73 20 61 6e 20 55 4e 52 45 53 2d 4e 41 4d is an UNRES-NAM
af20: 45 2e 20 45 4c 45 4d 53 20 69 73 20 61 6e 20 69 E. ELEMS is an i
af30: 6e 73 74 61 6e 63 65 20 6f 66 20 78 6d 6c 2d 64 nstance of xml-d
af40: 65 63 6c 3a 3a 65 6c 65 6d 73 3b 0a 3b 20 69 74 ecl::elems;.; it
af50: 20 63 61 6e 20 62 65 20 23 66 20 74 6f 20 74 65 can be #f to te
af60: 6c 6c 20 74 68 65 20 66 75 6e 63 74 69 6f 6e 20 ll the function
af70: 74 6f 20 64 6f 20 5f 6e 6f 5f 20 76 61 6c 69 64 to do _no_ valid
af80: 61 74 69 6f 6e 20 6f 66 20 65 6c 65 6d 65 6e 74 ation of element
af90: 73 0a 3b 20 61 6e 64 20 74 68 65 69 72 20 61 74 s.; and their at
afa0: 74 72 69 62 75 74 65 73 2e 0a 3b 0a 3b 20 54 68 tributes..;.; Th
afb0: 69 73 20 70 72 6f 63 65 64 75 72 65 20 72 65 74 is procedure ret
afc0: 75 72 6e 73 20 73 65 76 65 72 61 6c 20 76 61 6c urns several val
afd0: 75 65 73 3a 0a 3b 20 20 45 4c 45 4d 2d 47 49 3a ues:.; ELEM-GI:
afe0: 20 61 20 52 45 53 2d 4e 41 4d 45 2e 0a 3b 20 20 a RES-NAME..;
aff0: 41 54 54 52 49 42 55 54 45 53 3a 20 65 6c 65 6d ATTRIBUTES: elem
b000: 65 6e 74 27 73 20 61 74 74 72 69 62 75 74 65 73 ent's attributes
b010: 2c 20 61 6e 20 41 54 54 4c 49 53 54 20 6f 66 20 , an ATTLIST of
b020: 28 52 45 53 2d 4e 41 4d 45 20 2e 20 53 54 52 49 (RES-NAME . STRI
b030: 4e 47 29 0a 3b 09 70 61 69 72 73 2e 20 54 68 65 NG).;.pairs. The
b040: 20 6c 69 73 74 20 64 6f 65 73 20 4e 4f 54 20 69 list does NOT i
b050: 6e 63 6c 75 64 65 20 78 6d 6c 6e 73 20 61 74 74 nclude xmlns att
b060: 72 69 62 75 74 65 73 2e 0a 3b 20 20 4e 41 4d 45 ributes..; NAME
b070: 53 50 41 43 45 53 3a 20 74 68 65 20 69 6e 70 75 SPACES: the inpu
b080: 74 20 6c 69 73 74 20 6f 66 20 6e 61 6d 65 73 70 t list of namesp
b090: 61 63 65 73 20 61 6d 65 6e 64 65 64 20 77 69 74 aces amended wit
b0a0: 68 20 6e 61 6d 65 73 70 61 63 65 0a 3b 09 28 72 h namespace.;.(r
b0b0: 65 2d 29 64 65 63 6c 61 72 61 74 69 6f 6e 73 20 e-)declarations
b0c0: 63 6f 6e 74 61 69 6e 65 64 20 77 69 74 68 69 6e contained within
b0d0: 20 74 68 65 20 73 74 61 72 74 2d 74 61 67 20 75 the start-tag u
b0e0: 6e 64 65 72 20 70 61 72 73 69 6e 67 0a 3b 20 20 nder parsing.;
b0f0: 45 4c 45 4d 2d 43 4f 4e 54 45 4e 54 2d 4d 4f 44 ELEM-CONTENT-MOD
b100: 45 4c 0a 0a 3b 20 4f 6e 20 65 78 69 74 2c 20 74 EL..; On exit, t
b110: 68 65 20 63 75 72 72 65 6e 74 20 70 6f 73 69 74 he current posit
b120: 69 6f 6e 20 69 6e 20 50 4f 52 54 20 77 69 6c 6c ion in PORT will
b130: 20 62 65 20 74 68 65 20 66 69 72 73 74 20 63 68 be the first ch
b140: 61 72 61 63 74 65 72 20 61 66 74 65 72 0a 3b 20 aracter after.;
b150: 23 5c 3e 20 74 68 61 74 20 74 65 72 6d 69 6e 61 #\> that termina
b160: 74 65 73 20 74 68 65 20 73 74 61 72 74 2d 74 61 tes the start-ta
b170: 67 20 6d 61 72 6b 75 70 2e 0a 3b 0a 3b 20 46 61 g markup..;.; Fa
b180: 75 6c 74 73 20 64 65 74 65 63 74 65 64 3a 0a 3b ults detected:.;
b190: 09 56 43 3a 20 58 4d 4c 2d 53 70 65 63 2e 68 74 .VC: XML-Spec.ht
b1a0: 6d 6c 23 65 6e 75 6d 20 0a 3b 09 56 43 3a 20 58 ml#enum .;.VC: X
b1b0: 4d 4c 2d 53 70 65 63 2e 68 74 6d 6c 23 52 65 71 ML-Spec.html#Req
b1c0: 75 69 72 65 64 41 74 74 72 0a 3b 09 56 43 3a 20 uiredAttr.;.VC:
b1d0: 58 4d 4c 2d 53 70 65 63 2e 68 74 6d 6c 23 46 69 XML-Spec.html#Fi
b1e0: 78 65 64 41 74 74 72 0a 3b 09 56 43 3a 20 58 4d xedAttr.;.VC: XM
b1f0: 4c 2d 53 70 65 63 2e 68 74 6d 6c 23 56 61 6c 75 L-Spec.html#Valu
b200: 65 54 79 70 65 0a 3b 09 57 46 43 3a 20 58 4d 4c eType.;.WFC: XML
b210: 2d 53 70 65 63 2e 68 74 6d 6c 23 75 6e 69 71 61 -Spec.html#uniqa
b220: 74 74 73 70 65 63 20 28 61 66 74 65 72 20 6e 61 ttspec (after na
b230: 6d 65 73 70 61 63 65 73 20 70 72 65 66 69 78 65 mespaces prefixe
b240: 73 20 61 72 65 20 72 65 73 6f 6c 76 65 64 29 0a s are resolved).
b250: 3b 09 56 43 3a 20 58 4d 4c 2d 53 70 65 63 2e 68 ;.VC: XML-Spec.h
b260: 74 6d 6c 23 65 6c 65 6d 65 6e 74 76 61 6c 69 64 tml#elementvalid
b270: 20 0a 3b 09 57 46 43 3a 20 52 45 43 2d 78 6d 6c .;.WFC: REC-xml
b280: 2d 6e 61 6d 65 73 2f 23 64 74 2d 4e 53 4e 61 6d -names/#dt-NSNam
b290: 65 0a 0a 3b 20 4e 6f 74 65 2c 20 61 6c 74 68 6f e..; Note, altho
b2a0: 75 67 68 20 58 4d 4c 20 52 65 63 6f 6d 6d 65 6e ugh XML Recommen
b2b0: 64 61 74 69 6f 6e 20 64 6f 65 73 20 6e 6f 74 20 dation does not
b2c0: 65 78 70 6c 69 63 69 74 6c 79 20 73 61 79 20 69 explicitly say i
b2d0: 74 2c 0a 3b 20 78 6d 6c 6e 73 20 61 6e 64 20 78 t,.; xmlns and x
b2e0: 6d 6c 6e 73 3a 20 61 74 74 72 69 62 75 74 65 73 mlns: attributes
b2f0: 20 64 6f 6e 27 74 20 68 61 76 65 20 74 6f 20 62 don't have to b
b300: 65 20 64 65 63 6c 61 72 65 64 20 28 61 6c 74 68 e declared (alth
b310: 6f 75 67 68 20 74 68 65 79 0a 3b 20 63 61 6e 20 ough they.; can
b320: 62 65 20 64 65 63 6c 61 72 65 64 2c 20 74 6f 20 be declared, to
b330: 73 70 65 63 69 66 79 20 74 68 65 69 72 20 64 65 specify their de
b340: 66 61 75 6c 74 20 76 61 6c 75 65 29 0a 0a 3b 20 fault value)..;
b350: 50 72 6f 63 65 64 75 72 65 3a 20 20 73 73 61 78 Procedure: ssax
b360: 3a 63 6f 6d 70 6c 65 74 65 2d 73 74 61 72 74 2d :complete-start-
b370: 74 61 67 20 74 61 67 2d 68 65 61 64 20 70 6f 72 tag tag-head por
b380: 74 20 65 6c 65 6d 73 20 65 6e 74 69 74 69 65 73 t elems entities
b390: 20 6e 61 6d 65 73 70 61 63 65 73 0a 28 64 65 66 namespaces.(def
b3a0: 69 6e 65 20 73 73 61 78 3a 63 6f 6d 70 6c 65 74 ine ssax:complet
b3b0: 65 2d 73 74 61 72 74 2d 74 61 67 0a 0a 20 28 6c e-start-tag.. (l
b3c0: 65 74 20 28 28 78 6d 6c 6e 73 20 28 73 74 72 69 et ((xmlns (stri
b3d0: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 78 6d 6c 6e ng->symbol "xmln
b3e0: 73 22 29 29 0a 20 20 20 20 20 20 20 28 6c 61 72 s")). (lar
b3f0: 67 65 73 74 2d 64 75 6d 6d 79 2d 64 65 63 6c 2d gest-dummy-decl-
b400: 61 74 74 72 20 28 6c 69 73 74 20 73 73 61 78 3a attr (list ssax:
b410: 6c 61 72 67 65 73 74 2d 75 6e 72 65 73 2d 6e 61 largest-unres-na
b420: 6d 65 20 23 66 20 23 66 20 23 66 29 29 29 0a 0a me #f #f #f)))..
b430: 20 20 3b 20 53 63 61 6e 20 74 68 72 6f 75 67 68 ; Scan through
b440: 20 74 68 65 20 61 74 74 6c 69 73 74 20 61 6e 64 the attlist and
b450: 20 76 61 6c 69 64 61 74 65 20 69 74 2c 20 61 67 validate it, ag
b460: 61 69 6e 73 74 20 64 65 63 6c 2d 61 74 74 72 73 ainst decl-attrs
b470: 0a 20 20 3b 20 52 65 74 75 72 6e 20 61 6e 20 61 . ; Return an a
b480: 73 73 6f 63 20 6c 69 73 74 20 77 69 74 68 20 61 ssoc list with a
b490: 64 64 65 64 20 66 69 78 65 64 20 6f 72 20 69 6d dded fixed or im
b4a0: 70 6c 69 65 64 20 61 74 74 72 73 2e 0a 20 20 3b plied attrs.. ;
b4b0: 20 4e 6f 74 65 20 74 68 61 74 20 62 6f 74 68 20 Note that both
b4c0: 61 74 74 6c 69 73 74 20 61 6e 64 20 64 65 63 6c attlist and decl
b4d0: 2d 61 74 74 72 73 20 61 72 65 20 41 54 54 4c 49 -attrs are ATTLI
b4e0: 53 54 73 2c 20 61 6e 64 20 74 68 65 72 65 66 6f STs, and therefo
b4f0: 72 65 2c 0a 20 20 3b 20 73 6f 72 74 65 64 0a 20 re,. ; sorted.
b500: 20 28 64 65 66 69 6e 65 20 28 76 61 6c 69 64 61 (define (valida
b510: 74 65 2d 61 74 74 72 73 20 70 6f 72 74 20 61 74 te-attrs port at
b520: 74 6c 69 73 74 20 64 65 63 6c 2d 61 74 74 72 73 tlist decl-attrs
b530: 29 0a 0a 20 20 20 20 3b 20 43 68 65 63 6b 20 74 ).. ; Check t
b540: 6f 20 73 65 65 20 64 65 63 6c 2d 61 74 74 72 20 o see decl-attr
b550: 69 73 20 6e 6f 74 20 6f 66 20 75 73 65 20 74 79 is not of use ty
b560: 70 65 20 52 45 51 55 49 52 45 44 2e 20 41 64 64 pe REQUIRED. Add
b570: 0a 20 20 20 20 3b 20 74 68 65 20 61 73 73 6f 63 . ; the assoc
b580: 69 61 74 69 6f 6e 20 77 69 74 68 20 74 68 65 20 iation with the
b590: 64 65 66 61 75 6c 74 20 76 61 6c 75 65 2c 20 69 default value, i
b5a0: 66 20 61 6e 79 20 64 65 63 6c 61 72 65 64 0a 20 f any declared.
b5b0: 20 20 20 28 64 65 66 69 6e 65 20 28 61 64 64 2d (define (add-
b5c0: 64 65 66 61 75 6c 74 2d 64 65 63 6c 20 64 65 63 default-decl dec
b5d0: 6c 2d 61 74 74 72 20 72 65 73 75 6c 74 29 0a 20 l-attr result).
b5e0: 20 20 20 20 20 28 6c 65 74 2a 2d 76 61 6c 75 65 (let*-value
b5f0: 73 0a 09 20 28 28 28 61 74 74 72 2d 6e 61 6d 65 s.. (((attr-name
b600: 20 63 6f 6e 74 65 6e 74 2d 74 79 70 65 20 75 73 content-type us
b610: 65 2d 74 79 70 65 20 64 65 66 61 75 6c 74 2d 76 e-type default-v
b620: 61 6c 75 65 29 0a 09 20 20 20 28 61 70 70 6c 79 alue).. (apply
b630: 20 76 61 6c 75 65 73 20 64 65 63 6c 2d 61 74 74 values decl-att
b640: 72 29 29 29 0a 09 20 28 61 6e 64 20 28 65 71 3f r))).. (and (eq?
b650: 20 75 73 65 2d 74 79 70 65 20 27 52 45 51 55 49 use-type 'REQUI
b660: 52 45 44 29 0a 09 20 20 20 20 20 20 28 70 61 72 RED).. (par
b670: 73 65 72 2d 65 72 72 6f 72 20 70 6f 72 74 20 22 ser-error port "
b680: 5b 52 65 71 75 69 72 65 64 41 74 74 72 5d 20 62 [RequiredAttr] b
b690: 72 6f 6b 65 6e 20 66 6f 72 22 20 61 74 74 72 2d roken for" attr-
b6a0: 6e 61 6d 65 29 29 0a 09 20 28 69 66 20 64 65 66 name)).. (if def
b6b0: 61 75 6c 74 2d 76 61 6c 75 65 0a 09 20 20 20 20 ault-value..
b6c0: 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 61 74 74 (cons (cons att
b6d0: 72 2d 6e 61 6d 65 20 64 65 66 61 75 6c 74 2d 76 r-name default-v
b6e0: 61 6c 75 65 29 20 72 65 73 75 6c 74 29 0a 09 20 alue) result)..
b6f0: 20 20 20 20 72 65 73 75 6c 74 29 29 29 0a 0a 20 result)))..
b700: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 61 (let loop ((a
b710: 74 74 6c 69 73 74 20 61 74 74 6c 69 73 74 29 20 ttlist attlist)
b720: 28 64 65 63 6c 2d 61 74 74 72 73 20 64 65 63 6c (decl-attrs decl
b730: 2d 61 74 74 72 73 29 20 28 72 65 73 75 6c 74 20 -attrs) (result
b740: 27 28 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 '())). (if
b750: 28 61 74 74 6c 69 73 74 2d 6e 75 6c 6c 3f 20 61 (attlist-null? a
b760: 74 74 6c 69 73 74 29 0a 09 20 20 28 61 74 74 6c ttlist).. (attl
b770: 69 73 74 2d 66 6f 6c 64 20 61 64 64 2d 64 65 66 ist-fold add-def
b780: 61 75 6c 74 2d 64 65 63 6c 20 72 65 73 75 6c 74 ault-decl result
b790: 20 64 65 63 6c 2d 61 74 74 72 73 29 0a 09 20 20 decl-attrs)..
b7a0: 28 6c 65 74 2a 2d 76 61 6c 75 65 73 0a 09 20 20 (let*-values..
b7b0: 20 28 28 28 61 74 74 72 20 61 74 74 72 2d 6f 74 (((attr attr-ot
b7c0: 68 65 72 73 29 0a 09 20 20 20 20 20 28 61 74 74 hers).. (att
b7d0: 6c 69 73 74 2d 72 65 6d 6f 76 65 2d 74 6f 70 20 list-remove-top
b7e0: 61 74 74 6c 69 73 74 29 29 0a 09 20 20 20 20 28 attlist)).. (
b7f0: 28 64 65 63 6c 2d 61 74 74 72 20 6f 74 68 65 72 (decl-attr other
b800: 2d 64 65 63 6c 73 29 0a 09 20 20 20 20 20 28 69 -decls).. (i
b810: 66 20 28 61 74 74 6c 69 73 74 2d 6e 75 6c 6c 3f f (attlist-null?
b820: 20 64 65 63 6c 2d 61 74 74 72 73 29 0a 09 09 20 decl-attrs)...
b830: 28 76 61 6c 75 65 73 20 6c 61 72 67 65 73 74 2d (values largest-
b840: 64 75 6d 6d 79 2d 64 65 63 6c 2d 61 74 74 72 20 dummy-decl-attr
b850: 64 65 63 6c 2d 61 74 74 72 73 29 0a 09 09 20 28 decl-attrs)... (
b860: 61 74 74 6c 69 73 74 2d 72 65 6d 6f 76 65 2d 74 attlist-remove-t
b870: 6f 70 20 64 65 63 6c 2d 61 74 74 72 73 29 29 29 op decl-attrs)))
b880: 0a 09 20 20 20 20 29 0a 09 20 20 20 28 63 61 73 .. ).. (cas
b890: 65 20 28 6e 61 6d 65 2d 63 6f 6d 70 61 72 65 20 e (name-compare
b8a0: 28 63 61 72 20 61 74 74 72 29 20 28 63 61 72 20 (car attr) (car
b8b0: 64 65 63 6c 2d 61 74 74 72 29 29 0a 09 20 20 20 decl-attr))..
b8c0: 20 20 28 28 3c 29 20 0a 09 20 20 20 20 20 20 28 ((<) .. (
b8d0: 69 66 20 28 6f 72 20 28 65 71 3f 20 78 6d 6c 6e if (or (eq? xmln
b8e0: 73 20 28 63 61 72 20 61 74 74 72 29 29 0a 09 09 s (car attr))...
b8f0: 20 20 20 20 20 20 28 61 6e 64 20 28 70 61 69 72 (and (pair
b900: 3f 20 28 63 61 72 20 61 74 74 72 29 29 20 28 65 ? (car attr)) (e
b910: 71 3f 20 78 6d 6c 6e 73 20 28 63 61 61 72 20 61 q? xmlns (caar a
b920: 74 74 72 29 29 29 29 0a 09 09 20 20 28 6c 6f 6f ttr))))... (loo
b930: 70 20 61 74 74 72 2d 6f 74 68 65 72 73 20 64 65 p attr-others de
b940: 63 6c 2d 61 74 74 72 73 20 28 63 6f 6e 73 20 61 cl-attrs (cons a
b950: 74 74 72 20 72 65 73 75 6c 74 29 29 0a 09 09 20 ttr result))...
b960: 20 28 70 61 72 73 65 72 2d 65 72 72 6f 72 20 70 (parser-error p
b970: 6f 72 74 20 22 5b 56 61 6c 75 65 54 79 70 65 5d ort "[ValueType]
b980: 20 62 72 6f 6b 65 6e 20 66 6f 72 20 22 20 61 74 broken for " at
b990: 74 72 29 29 29 0a 09 20 20 20 20 20 28 28 3e 29 tr))).. ((>)
b9a0: 20 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 61 .. (loop a
b9b0: 74 74 6c 69 73 74 20 6f 74 68 65 72 2d 64 65 63 ttlist other-dec
b9c0: 6c 73 20 0a 09 09 20 20 20 20 28 61 64 64 2d 64 ls ... (add-d
b9d0: 65 66 61 75 6c 74 2d 64 65 63 6c 20 64 65 63 6c efault-decl decl
b9e0: 2d 61 74 74 72 20 72 65 73 75 6c 74 29 29 29 0a -attr result))).
b9f0: 09 20 20 20 20 20 28 65 6c 73 65 09 3b 20 6d 61 . (else.; ma
ba00: 74 63 68 65 64 20 6f 63 63 75 72 72 65 6e 63 65 tched occurrence
ba10: 20 6f 66 20 61 6e 20 61 74 74 72 20 77 69 74 68 of an attr with
ba20: 20 69 74 73 20 64 65 63 6c 61 72 61 74 69 6f 6e its declaration
ba30: 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 2d 76 61 .. (let*-va
ba40: 6c 75 65 73 0a 09 20 20 20 20 20 20 20 28 28 28 lues.. (((
ba50: 61 74 74 72 2d 6e 61 6d 65 20 63 6f 6e 74 65 6e attr-name conten
ba60: 74 2d 74 79 70 65 20 75 73 65 2d 74 79 70 65 20 t-type use-type
ba70: 64 65 66 61 75 6c 74 2d 76 61 6c 75 65 29 0a 09 default-value)..
ba80: 09 20 28 61 70 70 6c 79 20 76 61 6c 75 65 73 20 . (apply values
ba90: 64 65 63 6c 2d 61 74 74 72 29 29 29 0a 09 20 20 decl-attr)))..
baa0: 20 20 20 20 20 3b 20 52 75 6e 20 73 6f 6d 65 20 ; Run some
bab0: 74 65 73 74 73 20 6f 6e 20 74 68 65 20 63 6f 6e tests on the con
bac0: 74 65 6e 74 20 6f 66 20 74 68 65 20 61 74 74 72 tent of the attr
bad0: 69 62 75 74 65 0a 09 20 20 20 20 20 20 20 28 63 ibute.. (c
bae0: 6f 6e 64 0a 09 09 28 28 65 71 3f 20 75 73 65 2d ond...((eq? use-
baf0: 74 79 70 65 20 27 46 49 58 45 44 29 0a 09 09 20 type 'FIXED)...
bb00: 28 6f 72 20 28 65 71 75 61 6c 3f 20 28 63 64 72 (or (equal? (cdr
bb10: 20 61 74 74 72 29 20 64 65 66 61 75 6c 74 2d 76 attr) default-v
bb20: 61 6c 75 65 29 0a 09 09 20 20 20 20 20 28 70 61 alue)... (pa
bb30: 72 73 65 72 2d 65 72 72 6f 72 20 70 6f 72 74 20 rser-error port
bb40: 22 5b 46 69 78 65 64 41 74 74 72 5d 20 62 72 6f "[FixedAttr] bro
bb50: 6b 65 6e 20 66 6f 72 20 22 20 61 74 74 72 2d 6e ken for " attr-n
bb60: 61 6d 65 29 29 29 0a 09 09 28 28 65 71 3f 20 63 ame)))...((eq? c
bb70: 6f 6e 74 65 6e 74 2d 74 79 70 65 20 27 43 44 41 ontent-type 'CDA
bb80: 54 41 29 20 23 74 29 20 3b 20 65 76 65 72 79 74 TA) #t) ; everyt
bb90: 68 69 6e 67 20 67 6f 65 73 0a 09 09 28 28 70 61 hing goes...((pa
bba0: 69 72 3f 20 63 6f 6e 74 65 6e 74 2d 74 79 70 65 ir? content-type
bbb0: 29 0a 09 09 20 28 6f 72 20 28 6d 65 6d 62 65 72 )... (or (member
bbc0: 20 28 63 64 72 20 61 74 74 72 29 20 63 6f 6e 74 (cdr attr) cont
bbd0: 65 6e 74 2d 74 79 70 65 29 0a 09 09 20 20 20 20 ent-type)...
bbe0: 20 28 70 61 72 73 65 72 2d 65 72 72 6f 72 20 70 (parser-error p
bbf0: 6f 72 74 20 22 5b 65 6e 75 6d 5d 20 62 72 6f 6b ort "[enum] brok
bc00: 65 6e 20 66 6f 72 20 22 20 61 74 74 72 2d 6e 61 en for " attr-na
bc10: 6d 65 20 22 3d 22 0a 09 09 09 20 20 20 20 28 63 me "=".... (c
bc20: 64 72 20 61 74 74 72 29 29 29 29 0a 09 09 28 65 dr attr))))...(e
bc30: 6c 73 65 0a 09 09 20 28 73 73 61 78 3a 77 61 72 lse... (ssax:war
bc40: 6e 20 70 6f 72 74 20 22 64 65 63 6c 61 72 65 64 n port "declared
bc50: 20 63 6f 6e 74 65 6e 74 20 74 79 70 65 20 22 20 content type "
bc60: 63 6f 6e 74 65 6e 74 2d 74 79 70 65 0a 09 09 20 content-type...
bc70: 20 20 20 20 20 20 22 20 6e 6f 74 20 76 65 72 69 " not veri
bc80: 66 69 65 64 20 79 65 74 22 29 29 29 0a 09 20 20 fied yet")))..
bc90: 20 20 20 20 20 28 6c 6f 6f 70 20 61 74 74 72 2d (loop attr-
bca0: 6f 74 68 65 72 73 20 6f 74 68 65 72 2d 64 65 63 others other-dec
bcb0: 6c 73 20 28 63 6f 6e 73 20 61 74 74 72 20 72 65 ls (cons attr re
bcc0: 73 75 6c 74 29 29 29 29 29 0a 09 20 20 20 29 29 sult))))).. ))
bcd0: 29 29 0a 09 20 20 20 20 0a 0a 20 20 3b 20 41 64 )).. .. ; Ad
bce0: 64 20 61 20 6e 65 77 20 6e 61 6d 65 73 70 61 63 d a new namespac
bcf0: 65 20 64 65 63 6c 61 72 61 74 69 6f 6e 20 74 6f e declaration to
bd00: 20 6e 61 6d 65 73 70 61 63 65 73 2e 0a 20 20 3b namespaces.. ;
bd10: 20 46 69 72 73 74 20 77 65 20 63 6f 6e 76 65 72 First we conver
bd20: 74 20 74 68 65 20 75 72 69 2d 73 74 72 20 74 6f t the uri-str to
bd30: 20 61 20 75 72 69 2d 73 79 6d 62 6f 6c 20 61 6e a uri-symbol an
bd40: 64 20 73 65 61 72 63 68 20 6e 61 6d 65 73 70 61 d search namespa
bd50: 63 65 73 20 66 6f 72 0a 20 20 3b 20 61 6e 20 61 ces for. ; an a
bd60: 73 73 6f 63 69 61 74 69 6f 6e 20 28 5f 20 75 73 ssociation (_ us
bd70: 65 72 2d 70 72 65 66 69 78 20 2e 20 75 72 69 2d er-prefix . uri-
bd80: 73 79 6d 62 6f 6c 29 2e 0a 20 20 3b 20 49 66 20 symbol).. ; If
bd90: 66 6f 75 6e 64 2c 20 77 65 20 72 65 74 75 72 6e found, we return
bda0: 20 74 68 65 20 61 72 67 75 6d 65 6e 74 20 6e 61 the argument na
bdb0: 6d 65 73 70 61 63 65 73 20 77 69 74 68 20 61 6e mespaces with an
bdc0: 20 61 73 73 6f 63 69 61 74 69 6f 6e 0a 20 20 3b association. ;
bdd0: 20 28 70 72 65 66 69 78 20 75 73 65 72 2d 70 72 (prefix user-pr
bde0: 65 66 69 78 20 2e 20 75 72 69 2d 73 79 6d 62 6f efix . uri-symbo
bdf0: 6c 29 20 70 72 65 70 65 6e 64 65 64 2e 0a 20 20 l) prepended..
be00: 3b 20 4f 74 68 65 72 77 69 73 65 2c 20 77 65 20 ; Otherwise, we
be10: 70 72 65 70 65 6e 64 20 28 70 72 65 66 69 78 20 prepend (prefix
be20: 75 72 69 2d 73 79 6d 62 6f 6c 20 2e 20 75 72 69 uri-symbol . uri
be30: 2d 73 79 6d 62 6f 6c 29 0a 20 20 28 64 65 66 69 -symbol). (defi
be40: 6e 65 20 28 61 64 64 2d 6e 73 20 70 6f 72 74 20 ne (add-ns port
be50: 70 72 65 66 69 78 20 75 72 69 2d 73 74 72 20 6e prefix uri-str n
be60: 61 6d 65 73 70 61 63 65 73 29 0a 20 20 20 20 28 amespaces). (
be70: 61 6e 64 20 28 65 71 75 61 6c 3f 20 22 22 20 75 and (equal? "" u
be80: 72 69 2d 73 74 72 29 0a 09 20 28 70 61 72 73 65 ri-str).. (parse
be90: 72 2d 65 72 72 6f 72 20 70 6f 72 74 20 22 5b 64 r-error port "[d
bea0: 74 2d 4e 53 4e 61 6d 65 5d 20 62 72 6f 6b 65 6e t-NSName] broken
beb0: 20 66 6f 72 20 22 20 70 72 65 66 69 78 29 29 0a for " prefix)).
bec0: 20 20 20 20 28 6c 65 74 20 28 28 75 72 69 2d 73 (let ((uri-s
bed0: 79 6d 62 6f 6c 20 28 73 73 61 78 3a 75 72 69 2d ymbol (ssax:uri-
bee0: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 75 string->symbol u
bef0: 72 69 2d 73 74 72 29 29 29 0a 20 20 20 20 20 20 ri-str))).
bf00: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6e 73 73 20 (let loop ((nss
bf10: 6e 61 6d 65 73 70 61 63 65 73 29 29 0a 09 28 63 namespaces))..(c
bf20: 6f 6e 64 20 0a 09 20 28 28 6e 75 6c 6c 3f 20 6e ond .. ((null? n
bf30: 73 73 29 0a 09 20 20 28 63 6f 6e 73 20 28 63 6f ss).. (cons (co
bf40: 6e 73 2a 20 70 72 65 66 69 78 20 75 72 69 2d 73 ns* prefix uri-s
bf50: 79 6d 62 6f 6c 20 75 72 69 2d 73 79 6d 62 6f 6c ymbol uri-symbol
bf60: 29 20 6e 61 6d 65 73 70 61 63 65 73 29 29 0a 09 ) namespaces))..
bf70: 20 28 28 65 71 3f 20 75 72 69 2d 73 79 6d 62 6f ((eq? uri-symbo
bf80: 6c 20 28 63 64 64 61 72 20 6e 73 73 29 29 0a 09 l (cddar nss))..
bf90: 20 20 28 63 6f 6e 73 20 28 63 6f 6e 73 2a 20 70 (cons (cons* p
bfa0: 72 65 66 69 78 20 28 63 61 64 61 72 20 6e 73 73 refix (cadar nss
bfb0: 29 20 75 72 69 2d 73 79 6d 62 6f 6c 29 20 6e 61 ) uri-symbol) na
bfc0: 6d 65 73 70 61 63 65 73 29 29 0a 09 20 28 65 6c mespaces)).. (el
bfd0: 73 65 20 28 6c 6f 6f 70 20 28 63 64 72 20 6e 73 se (loop (cdr ns
bfe0: 73 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 0a s))))))). .
bff0: 20 20 3b 20 70 61 72 74 69 74 69 6f 6e 20 61 74 ; partition at
c000: 74 72 73 20 69 6e 74 6f 20 70 72 6f 70 65 72 20 trs into proper
c010: 61 74 74 72 73 20 61 6e 64 20 6e 65 77 20 6e 61 attrs and new na
c020: 6d 65 73 70 61 63 65 20 64 65 63 6c 61 72 61 74 mespace declarat
c030: 69 6f 6e 73 0a 20 20 3b 20 72 65 74 75 72 6e 20 ions. ; return
c040: 74 77 6f 20 76 61 6c 75 65 73 3a 20 70 72 6f 70 two values: prop
c050: 65 72 20 61 74 74 72 73 20 61 6e 64 20 74 68 65 er attrs and the
c060: 20 75 70 64 61 74 65 64 20 6e 61 6d 65 73 70 61 updated namespa
c070: 63 65 20 64 65 63 6c 61 72 61 74 69 6f 6e 73 0a ce declarations.
c080: 20 20 28 64 65 66 69 6e 65 20 28 61 64 6a 75 73 (define (adjus
c090: 74 2d 6e 61 6d 65 73 70 61 63 65 2d 64 65 63 6c t-namespace-decl
c0a0: 20 70 6f 72 74 20 61 74 74 72 73 20 6e 61 6d 65 port attrs name
c0b0: 73 70 61 63 65 73 29 0a 20 20 20 20 28 6c 65 74 spaces). (let
c0c0: 20 6c 6f 6f 70 20 28 28 61 74 74 72 73 20 61 74 loop ((attrs at
c0d0: 74 72 73 29 20 28 70 72 6f 70 65 72 2d 61 74 74 trs) (proper-att
c0e0: 72 73 20 27 28 29 29 20 28 6e 61 6d 65 73 70 61 rs '()) (namespa
c0f0: 63 65 73 20 6e 61 6d 65 73 70 61 63 65 73 29 29 ces namespaces))
c100: 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 . (cond.
c110: 20 20 20 20 28 28 6e 75 6c 6c 3f 20 61 74 74 72 ((null? attr
c120: 73 29 20 28 76 61 6c 75 65 73 20 70 72 6f 70 65 s) (values prope
c130: 72 2d 61 74 74 72 73 20 6e 61 6d 65 73 70 61 63 r-attrs namespac
c140: 65 73 29 29 0a 20 20 20 20 20 20 20 28 28 65 71 es)). ((eq
c150: 3f 20 78 6d 6c 6e 73 20 28 63 61 61 72 20 61 74 ? xmlns (caar at
c160: 74 72 73 29 29 09 3b 20 72 65 2d 64 65 63 6c 20 trs)).; re-decl
c170: 6f 66 20 74 68 65 20 64 65 66 61 75 6c 74 20 6e of the default n
c180: 61 6d 65 73 70 61 63 65 0a 09 28 6c 6f 6f 70 20 amespace..(loop
c190: 28 63 64 72 20 61 74 74 72 73 29 20 70 72 6f 70 (cdr attrs) prop
c1a0: 65 72 2d 61 74 74 72 73 20 0a 09 20 20 20 20 20 er-attrs ..
c1b0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 22 22 20 (if (equal? ""
c1c0: 28 63 64 61 72 20 61 74 74 72 73 29 29 09 3b 20 (cdar attrs)).;
c1d0: 75 6e 2d 64 65 63 6c 20 6f 66 20 74 68 65 20 64 un-decl of the d
c1e0: 65 66 61 75 6c 74 20 6e 73 0a 09 09 20 20 28 63 efault ns... (c
c1f0: 6f 6e 73 20 28 63 6f 6e 73 2a 20 27 2a 44 45 46 ons (cons* '*DEF
c200: 41 55 4c 54 2a 20 23 66 20 23 66 29 20 6e 61 6d AULT* #f #f) nam
c210: 65 73 70 61 63 65 73 29 0a 09 09 20 20 28 61 64 espaces)... (ad
c220: 64 2d 6e 73 20 70 6f 72 74 20 27 2a 44 45 46 41 d-ns port '*DEFA
c230: 55 4c 54 2a 20 28 63 64 61 72 20 61 74 74 72 73 ULT* (cdar attrs
c240: 29 20 6e 61 6d 65 73 70 61 63 65 73 29 29 29 29 ) namespaces))))
c250: 0a 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 70 . ((and (p
c260: 61 69 72 3f 20 28 63 61 61 72 20 61 74 74 72 73 air? (caar attrs
c270: 29 29 20 28 65 71 3f 20 78 6d 6c 6e 73 20 28 63 )) (eq? xmlns (c
c280: 61 61 61 72 20 61 74 74 72 73 29 29 29 0a 09 28 aaar attrs)))..(
c290: 6c 6f 6f 70 20 28 63 64 72 20 61 74 74 72 73 29 loop (cdr attrs)
c2a0: 20 70 72 6f 70 65 72 2d 61 74 74 72 73 0a 09 20 proper-attrs..
c2b0: 20 20 20 20 20 28 61 64 64 2d 6e 73 20 70 6f 72 (add-ns por
c2c0: 74 20 28 63 64 61 61 72 20 61 74 74 72 73 29 20 t (cdaar attrs)
c2d0: 28 63 64 61 72 20 61 74 74 72 73 29 20 6e 61 6d (cdar attrs) nam
c2e0: 65 73 70 61 63 65 73 29 29 29 0a 20 20 20 20 20 espaces))).
c2f0: 20 20 28 65 6c 73 65 0a 09 28 6c 6f 6f 70 20 28 (else..(loop (
c300: 63 64 72 20 61 74 74 72 73 29 20 28 63 6f 6e 73 cdr attrs) (cons
c310: 20 28 63 61 72 20 61 74 74 72 73 29 20 70 72 6f (car attrs) pro
c320: 70 65 72 2d 61 74 74 72 73 29 20 6e 61 6d 65 73 per-attrs) names
c330: 70 61 63 65 73 29 29 29 29 29 0a 0a 20 20 20 20 paces)))))..
c340: 3b 20 54 68 65 20 62 6f 64 79 20 6f 66 20 74 68 ; The body of th
c350: 65 20 66 75 6e 63 74 69 6f 6e 0a 20 28 6c 61 6d e function. (lam
c360: 62 64 61 20 28 74 61 67 2d 68 65 61 64 20 70 6f bda (tag-head po
c370: 72 74 20 65 6c 65 6d 73 20 65 6e 74 69 74 69 65 rt elems entitie
c380: 73 20 6e 61 6d 65 73 70 61 63 65 73 29 0a 20 20 s namespaces).
c390: 28 6c 65 74 2a 2d 76 61 6c 75 65 73 0a 20 20 20 (let*-values.
c3a0: 28 28 28 61 74 74 6c 69 73 74 29 20 28 73 73 61 (((attlist) (ssa
c3b0: 78 3a 72 65 61 64 2d 61 74 74 72 69 62 75 74 65 x:read-attribute
c3c0: 73 20 70 6f 72 74 20 65 6e 74 69 74 69 65 73 29 s port entities)
c3d0: 29 0a 20 20 20 20 28 28 65 6d 70 74 79 2d 65 6c ). ((empty-el
c3e0: 2d 74 61 67 3f 29 0a 20 20 20 20 20 28 62 65 67 -tag?). (beg
c3f0: 69 6e 0a 20 20 20 20 20 20 20 28 73 73 61 78 3a in. (ssax:
c400: 73 6b 69 70 2d 53 20 70 6f 72 74 29 0a 20 20 20 skip-S port).
c410: 20 20 20 20 28 61 6e 64 0a 09 28 65 71 76 3f 20 (and..(eqv?
c420: 23 5c 2f 20 0a 09 20 20 20 20 20 20 28 61 73 73 #\/ .. (ass
c430: 65 72 74 2d 63 75 72 72 2d 63 68 61 72 20 27 28 ert-curr-char '(
c440: 23 5c 3e 20 23 5c 2f 29 20 22 58 4d 4c 20 5b 34 #\> #\/) "XML [4
c450: 30 5d 2c 20 58 4d 4c 20 5b 34 34 5d 2c 20 6e 6f 0], XML [44], no
c460: 20 27 3e 27 22 20 70 6f 72 74 29 29 0a 09 28 61 '>'" port))..(a
c470: 73 73 65 72 74 2d 63 75 72 72 2d 63 68 61 72 20 ssert-curr-char
c480: 27 28 23 5c 3e 29 20 22 58 4d 4c 20 5b 34 34 5d '(#\>) "XML [44]
c490: 2c 20 6e 6f 20 27 3e 27 22 20 70 6f 72 74 29 29 , no '>'" port))
c4a0: 29 29 0a 20 20 20 20 28 28 65 6c 65 6d 2d 63 6f )). ((elem-co
c4b0: 6e 74 65 6e 74 20 64 65 63 6c 2d 61 74 74 72 73 ntent decl-attrs
c4c0: 29 09 3b 20 73 65 65 20 78 6d 6c 2d 64 65 63 6c ).; see xml-decl
c4d0: 20 66 6f 72 20 74 68 65 69 72 20 74 79 70 65 0a for their type.
c4e0: 20 20 20 20 20 28 69 66 20 65 6c 65 6d 73 09 09 (if elems..
c4f0: 09 3b 20 65 6c 65 6d 65 6e 74 73 20 64 65 63 6c .; elements decl
c500: 61 72 65 64 3a 20 76 61 6c 69 64 61 74 65 21 0a ared: validate!.
c510: 09 20 28 63 6f 6e 64 0a 09 20 20 28 28 61 73 73 . (cond.. ((ass
c520: 6f 63 20 74 61 67 2d 68 65 61 64 20 65 6c 65 6d oc tag-head elem
c530: 73 29 20 3d 3e 0a 09 20 20 20 28 6c 61 6d 62 64 s) =>.. (lambd
c540: 61 20 28 64 65 63 6c 2d 65 6c 65 6d 29 09 09 3b a (decl-elem)..;
c550: 20 6f 66 20 74 79 70 65 20 78 6d 6c 2d 64 65 63 of type xml-dec
c560: 6c 3a 3a 64 65 63 6c 2d 65 6c 65 6d 0a 09 20 20 l::decl-elem..
c570: 20 20 20 28 76 61 6c 75 65 73 0a 09 20 20 20 20 (values..
c580: 20 20 28 69 66 20 65 6d 70 74 79 2d 65 6c 2d 74 (if empty-el-t
c590: 61 67 3f 20 27 45 4d 50 54 59 2d 54 41 47 20 28 ag? 'EMPTY-TAG (
c5a0: 63 61 64 72 20 64 65 63 6c 2d 65 6c 65 6d 29 29 cadr decl-elem))
c5b0: 0a 09 20 20 20 20 20 20 28 63 61 64 64 72 20 64 .. (caddr d
c5c0: 65 63 6c 2d 65 6c 65 6d 29 29 29 29 0a 09 20 20 ecl-elem))))..
c5d0: 28 65 6c 73 65 0a 09 20 20 20 28 70 61 72 73 65 (else.. (parse
c5e0: 72 2d 65 72 72 6f 72 20 70 6f 72 74 20 22 5b 65 r-error port "[e
c5f0: 6c 65 6d 65 6e 74 76 61 6c 69 64 5d 20 62 72 6f lementvalid] bro
c600: 6b 65 6e 2c 20 6e 6f 20 64 65 63 6c 20 66 6f 72 ken, no decl for
c610: 20 22 20 74 61 67 2d 68 65 61 64 29 29 29 0a 09 " tag-head)))..
c620: 20 28 76 61 6c 75 65 73 09 09 3b 20 6e 6f 6e 2d (values..; non-
c630: 76 61 6c 69 64 61 74 69 6e 67 20 70 61 72 73 69 validating parsi
c640: 6e 67 0a 09 20 20 28 69 66 20 65 6d 70 74 79 2d ng.. (if empty-
c650: 65 6c 2d 74 61 67 3f 20 27 45 4d 50 54 59 2d 54 el-tag? 'EMPTY-T
c660: 41 47 20 27 41 4e 59 29 0a 09 20 20 23 66 29 09 AG 'ANY).. #f).
c670: 09 09 3b 20 6e 6f 20 61 74 74 72 69 62 75 74 65 ..; no attribute
c680: 73 20 64 65 63 6c 61 72 65 64 0a 09 20 29 29 0a s declared.. )).
c690: 20 20 20 20 28 28 6d 65 72 67 65 64 2d 61 74 74 ((merged-att
c6a0: 72 73 29 20 28 69 66 20 64 65 63 6c 2d 61 74 74 rs) (if decl-att
c6b0: 72 73 20 28 76 61 6c 69 64 61 74 65 2d 61 74 74 rs (validate-att
c6c0: 72 73 20 70 6f 72 74 20 61 74 74 6c 69 73 74 20 rs port attlist
c6d0: 64 65 63 6c 2d 61 74 74 72 73 29 0a 09 09 20 20 decl-attrs)...
c6e0: 20 20 20 20 28 61 74 74 6c 69 73 74 2d 3e 61 6c (attlist->al
c6f0: 69 73 74 20 61 74 74 6c 69 73 74 29 29 29 0a 20 ist attlist))).
c700: 20 20 20 28 28 70 72 6f 70 65 72 2d 61 74 74 72 ((proper-attr
c710: 73 20 6e 61 6d 65 73 70 61 63 65 73 29 0a 20 20 s namespaces).
c720: 20 20 20 28 61 64 6a 75 73 74 2d 6e 61 6d 65 73 (adjust-names
c730: 70 61 63 65 2d 64 65 63 6c 20 70 6f 72 74 20 6d pace-decl port m
c740: 65 72 67 65 64 2d 61 74 74 72 73 20 6e 61 6d 65 erged-attrs name
c750: 73 70 61 63 65 73 29 29 0a 20 20 20 20 29 0a 20 spaces)). ).
c760: 20 20 3b 28 63 65 72 72 20 22 70 72 6f 70 65 72 ;(cerr "proper
c770: 20 61 74 74 72 73 3a 20 22 20 70 72 6f 70 65 72 attrs: " proper
c780: 2d 61 74 74 72 73 20 6e 6c 29 0a 20 20 20 3b 20 -attrs nl). ;
c790: 62 75 69 6c 64 20 74 68 65 20 72 65 74 75 72 6e build the return
c7a0: 20 76 61 6c 75 65 0a 20 20 20 28 76 61 6c 75 65 value. (value
c7b0: 73 0a 20 20 20 20 28 73 73 61 78 3a 72 65 73 6f s. (ssax:reso
c7c0: 6c 76 65 2d 6e 61 6d 65 20 70 6f 72 74 20 74 61 lve-name port ta
c7d0: 67 2d 68 65 61 64 20 6e 61 6d 65 73 70 61 63 65 g-head namespace
c7e0: 73 20 23 74 29 0a 20 20 20 20 28 66 6f 6c 64 2d s #t). (fold-
c7f0: 72 69 67 68 74 0a 20 20 20 20 20 28 6c 61 6d 62 right. (lamb
c800: 64 61 20 28 6e 61 6d 65 2d 76 61 6c 75 65 20 61 da (name-value a
c810: 74 74 6c 69 73 74 29 0a 20 20 20 20 20 20 20 28 ttlist). (
c820: 6f 72 0a 09 28 61 74 74 6c 69 73 74 2d 61 64 64 or..(attlist-add
c830: 20 61 74 74 6c 69 73 74 0a 09 20 20 20 28 63 6f attlist.. (co
c840: 6e 73 20 28 73 73 61 78 3a 72 65 73 6f 6c 76 65 ns (ssax:resolve
c850: 2d 6e 61 6d 65 20 70 6f 72 74 20 28 63 61 72 20 -name port (car
c860: 6e 61 6d 65 2d 76 61 6c 75 65 29 20 6e 61 6d 65 name-value) name
c870: 73 70 61 63 65 73 20 23 66 29 0a 09 09 20 28 63 spaces #f)... (c
c880: 64 72 20 6e 61 6d 65 2d 76 61 6c 75 65 29 29 29 dr name-value)))
c890: 0a 09 28 70 61 72 73 65 72 2d 65 72 72 6f 72 20 ..(parser-error
c8a0: 70 6f 72 74 20 22 5b 75 6e 69 71 61 74 74 73 70 port "[uniqattsp
c8b0: 65 63 5d 20 61 66 74 65 72 20 4e 53 20 65 78 70 ec] after NS exp
c8c0: 61 6e 73 69 6f 6e 20 62 72 6f 6b 65 6e 20 66 6f ansion broken fo
c8d0: 72 20 22 20 0a 09 20 20 20 20 20 20 20 6e 61 6d r " .. nam
c8e0: 65 2d 76 61 6c 75 65 29 29 29 0a 20 20 20 20 20 e-value))).
c8f0: 28 6d 61 6b 65 2d 65 6d 70 74 79 2d 61 74 74 6c (make-empty-attl
c900: 69 73 74 29 0a 20 20 20 20 20 70 72 6f 70 65 72 ist). proper
c910: 2d 61 74 74 72 73 29 0a 20 20 20 20 6e 61 6d 65 -attrs). name
c920: 73 70 61 63 65 73 0a 20 20 20 20 65 6c 65 6d 2d spaces. elem-
c930: 63 6f 6e 74 65 6e 74 29 29 29 29 29 0a 0a 0a 3b content)))))...;
c940: 20 70 72 6f 63 65 64 75 72 65 2b 3a 09 73 73 61 procedure+:.ssa
c950: 78 3a 72 65 61 64 2d 65 78 74 65 72 6e 61 6c 2d x:read-external-
c960: 69 64 20 50 4f 52 54 0a 3b 0a 3b 20 54 68 69 73 id PORT.;.; This
c970: 20 70 72 6f 63 65 64 75 72 65 20 70 61 72 73 65 procedure parse
c980: 73 20 61 6e 20 45 78 74 65 72 6e 61 6c 49 44 20 s an ExternalID
c990: 70 72 6f 64 75 63 74 69 6f 6e 3a 0a 3b 20 5b 37 production:.; [7
c9a0: 35 5d 20 45 78 74 65 72 6e 61 6c 49 44 20 3a 3a 5] ExternalID ::
c9b0: 3d 20 27 53 59 53 54 45 4d 27 20 53 20 53 79 73 = 'SYSTEM' S Sys
c9c0: 74 65 6d 4c 69 74 65 72 61 6c 0a 3b 09 09 7c 20 temLiteral.;..|
c9d0: 27 50 55 42 4c 49 43 27 20 53 20 50 75 62 69 64 'PUBLIC' S Pubid
c9e0: 4c 69 74 65 72 61 6c 20 53 20 53 79 73 74 65 6d Literal S System
c9f0: 4c 69 74 65 72 61 6c 0a 3b 20 5b 31 31 5d 20 53 Literal.; [11] S
ca00: 79 73 74 65 6d 4c 69 74 65 72 61 6c 20 3a 3a 3d ystemLiteral ::=
ca10: 20 28 27 22 27 20 5b 5e 22 5d 2a 20 27 22 27 29 ('"' [^"]* '"')
ca20: 20 7c 20 28 22 27 22 20 5b 5e 27 5d 2a 20 22 27 | ("'" [^']* "'
ca30: 22 29 20 0a 3b 20 5b 31 32 5d 20 50 75 62 69 64 ") .; [12] Pubid
ca40: 4c 69 74 65 72 61 6c 20 3a 3a 3d 20 20 27 22 27 Literal ::= '"'
ca50: 20 50 75 62 69 64 43 68 61 72 2a 20 27 22 27 20 PubidChar* '"'
ca60: 7c 20 22 27 22 20 28 50 75 62 69 64 43 68 61 72 | "'" (PubidChar
ca70: 20 2d 20 22 27 22 29 2a 20 22 27 22 0a 3b 20 5b - "'")* "'".; [
ca80: 31 33 5d 20 50 75 62 69 64 43 68 61 72 20 3a 3a 13] PubidChar ::
ca90: 3d 20 20 23 78 32 30 20 7c 20 23 78 44 20 7c 20 = #x20 | #xD |
caa0: 23 78 41 20 7c 20 5b 61 2d 7a 41 2d 5a 30 2d 39 #xA | [a-zA-Z0-9
cab0: 5d 0a 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ].;
cac0: 20 20 20 20 20 20 20 20 20 20 20 20 7c 20 5b 2d | [-
cad0: 27 28 29 2b 2c 2e 2f 3a 3d 3f 3b 21 2a 23 40 24 '()+,./:=?;!*#@$
cae0: 5f 25 5d 0a 3b 0a 3b 20 54 68 69 73 20 70 72 6f _%].;.; This pro
caf0: 63 65 64 75 72 65 20 69 73 20 73 75 70 70 6f 73 cedure is suppos
cb00: 65 64 20 74 6f 20 62 65 20 63 61 6c 6c 65 64 20 ed to be called
cb10: 77 68 65 6e 20 61 6e 20 45 78 74 65 72 6e 61 6c when an External
cb20: 49 44 20 69 73 20 65 78 70 65 63 74 65 64 3b 0a ID is expected;.
cb30: 3b 20 74 68 61 74 20 69 73 2c 20 74 68 65 20 63 ; that is, the c
cb40: 75 72 72 65 6e 74 20 63 68 61 72 61 63 74 65 72 urrent character
cb50: 20 6d 75 73 74 20 62 65 20 65 69 74 68 65 72 20 must be either
cb60: 23 5c 53 20 6f 72 20 23 5c 50 20 74 68 61 74 20 #\S or #\P that
cb70: 73 74 61 72 74 0a 3b 20 63 6f 72 72 65 73 70 6f start.; correspo
cb80: 6e 64 69 6e 67 6c 79 20 61 20 53 59 53 54 45 4d ndingly a SYSTEM
cb90: 20 6f 72 20 50 55 42 4c 49 43 20 74 6f 6b 65 6e or PUBLIC token
cba0: 2e 20 54 68 69 73 20 70 72 6f 63 65 64 75 72 65 . This procedure
cbb0: 20 72 65 74 75 72 6e 73 20 74 68 65 0a 3b 20 53 returns the.; S
cbc0: 79 73 74 65 6d 4c 69 74 65 72 61 6c 20 61 73 20 ystemLiteral as
cbd0: 61 20 73 74 72 69 6e 67 2e 20 41 20 50 75 62 69 a string. A Pubi
cbe0: 64 4c 69 74 65 72 61 6c 20 69 73 20 64 69 73 72 dLiteral is disr
cbf0: 65 67 61 72 64 65 64 20 69 66 20 70 72 65 73 65 egarded if prese
cc00: 6e 74 2e 0a 20 0a 28 64 65 66 69 6e 65 20 28 73 nt.. .(define (s
cc10: 73 61 78 3a 72 65 61 64 2d 65 78 74 65 72 6e 61 sax:read-externa
cc20: 6c 2d 69 64 20 70 6f 72 74 29 0a 20 20 28 6c 65 l-id port). (le
cc30: 74 20 28 28 64 69 73 63 72 69 6d 69 6e 61 74 6f t ((discriminato
cc40: 72 20 28 73 73 61 78 3a 72 65 61 64 2d 4e 43 4e r (ssax:read-NCN
cc50: 61 6d 65 20 70 6f 72 74 29 29 29 0a 20 20 20 20 ame port))).
cc60: 28 61 73 73 65 72 74 2d 63 75 72 72 2d 63 68 61 (assert-curr-cha
cc70: 72 20 73 73 61 78 3a 53 2d 63 68 61 72 73 20 22 r ssax:S-chars "
cc80: 73 70 61 63 65 20 61 66 74 65 72 20 53 59 53 54 space after SYST
cc90: 45 4d 20 6f 72 20 50 55 42 4c 49 43 22 20 70 6f EM or PUBLIC" po
cca0: 72 74 29 0a 20 20 20 20 28 73 73 61 78 3a 73 6b rt). (ssax:sk
ccb0: 69 70 2d 53 20 70 6f 72 74 29 0a 20 20 20 20 28 ip-S port). (
ccc0: 6c 65 74 20 28 28 64 65 6c 69 6d 69 74 65 72 20 let ((delimiter
ccd0: 0a 20 20 20 20 20 20 20 20 20 20 28 61 73 73 65 . (asse
cce0: 72 74 2d 63 75 72 72 2d 63 68 61 72 20 27 28 23 rt-curr-char '(#
ccf0: 5c 27 20 23 5c 22 20 29 20 22 58 4d 4c 20 5b 31 \' #\" ) "XML [1
cd00: 31 5d 2c 20 58 4d 4c 20 5b 31 32 5d 22 20 70 6f 1], XML [12]" po
cd10: 72 74 29 29 29 0a 20 20 20 20 20 20 28 63 6f 6e rt))). (con
cd20: 64 0a 20 20 20 20 20 20 20 20 28 28 65 71 3f 20 d. ((eq?
cd30: 64 69 73 63 72 69 6d 69 6e 61 74 6f 72 20 28 73 discriminator (s
cd40: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 53 tring->symbol "S
cd50: 59 53 54 45 4d 22 29 29 0a 20 20 20 20 20 20 20 YSTEM")).
cd60: 20 20 20 28 62 65 67 69 6e 30 0a 20 20 20 20 20 (begin0.
cd70: 20 20 20 20 20 20 20 28 6e 65 78 74 2d 74 6f 6b (next-tok
cd80: 65 6e 20 27 28 29 20 28 6c 69 73 74 20 64 65 6c en '() (list del
cd90: 69 6d 69 74 65 72 29 20 22 58 4d 4c 20 5b 31 31 imiter) "XML [11
cda0: 5d 22 20 70 6f 72 74 29 0a 20 20 20 20 20 20 20 ]" port).
cdb0: 20 20 20 20 20 28 72 65 61 64 2d 63 68 61 72 20 (read-char
cdc0: 70 6f 72 74 29 09 3b 20 72 65 61 64 69 6e 67 20 port).; reading
cdd0: 74 68 65 20 63 6c 6f 73 69 6e 67 20 64 65 6c 69 the closing deli
cde0: 6d 0a 20 20 20 20 20 20 20 20 20 20 20 20 29 29 m. ))
cdf0: 0a 20 20 20 20 20 20 20 20 20 28 28 65 71 3f 20 . ((eq?
ce00: 64 69 73 63 72 69 6d 69 6e 61 74 6f 72 20 28 73 discriminator (s
ce10: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 50 tring->symbol "P
ce20: 55 42 4c 49 43 22 29 29 0a 20 20 20 20 20 20 20 UBLIC")).
ce30: 20 20 20 20 28 73 6b 69 70 2d 75 6e 74 69 6c 20 (skip-until
ce40: 28 6c 69 73 74 20 64 65 6c 69 6d 69 74 65 72 29 (list delimiter)
ce50: 20 70 6f 72 74 29 0a 20 20 20 20 20 20 20 20 20 port).
ce60: 20 20 28 61 73 73 65 72 74 2d 63 75 72 72 2d 63 (assert-curr-c
ce70: 68 61 72 20 73 73 61 78 3a 53 2d 63 68 61 72 73 har ssax:S-chars
ce80: 20 22 73 70 61 63 65 20 61 66 74 65 72 20 50 75 "space after Pu
ce90: 62 69 64 4c 69 74 65 72 61 6c 22 20 70 6f 72 74 bidLiteral" port
cea0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 73 73 ). (ss
ceb0: 61 78 3a 73 6b 69 70 2d 53 20 70 6f 72 74 29 0a ax:skip-S port).
cec0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
ced0: 20 28 28 64 65 6c 69 6d 69 74 65 72 20 0a 20 20 ((delimiter .
cee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cef0: 28 61 73 73 65 72 74 2d 63 75 72 72 2d 63 68 61 (assert-curr-cha
cf00: 72 20 27 28 23 5c 27 20 23 5c 22 20 29 20 22 58 r '(#\' #\" ) "X
cf10: 4d 4c 20 5b 31 31 5d 22 20 70 6f 72 74 29 29 0a ML [11]" port)).
cf20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cf30: 20 20 28 73 79 73 74 65 6d 69 64 0a 20 20 20 20 (systemid.
cf40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cf50: 28 6e 65 78 74 2d 74 6f 6b 65 6e 20 27 28 29 20 (next-token '()
cf60: 28 6c 69 73 74 20 64 65 6c 69 6d 69 74 65 72 29 (list delimiter)
cf70: 20 22 58 4d 4c 20 5b 31 31 5d 22 20 70 6f 72 74 "XML [11]" port
cf80: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
cf90: 20 20 20 20 28 72 65 61 64 2d 63 68 61 72 20 70 (read-char p
cfa0: 6f 72 74 29 09 3b 20 72 65 61 64 69 6e 67 20 74 ort).; reading t
cfb0: 68 65 20 63 6c 6f 73 69 6e 67 20 64 65 6c 69 6d he closing delim
cfc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
cfd0: 20 73 79 73 74 65 6d 69 64 29 29 0a 20 20 20 20 systemid)).
cfe0: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
cff0: 20 20 20 20 20 20 28 70 61 72 73 65 72 2d 65 72 (parser-er
d000: 72 6f 72 20 70 6f 72 74 20 22 58 4d 4c 20 5b 37 ror port "XML [7
d010: 35 5d 2c 20 22 20 64 69 73 63 72 69 6d 69 6e 61 5], " discrimina
d020: 74 6f 72 20 0a 09 09 20 20 22 20 72 61 74 68 65 tor ... " rathe
d030: 72 20 74 68 61 6e 20 53 59 53 54 45 4d 20 6f 72 r than SYSTEM or
d040: 20 50 55 42 4c 49 43 22 29 29 29 29 29 29 0a 0a PUBLIC"))))))..
d050: 0a 3b 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d .;--------------
d060: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
d070: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
d080: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
d090: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a ---------------.
d0a0: 3b 09 09 09 48 69 67 68 65 72 2d 6c 65 76 65 6c ;...Higher-level
d0b0: 20 70 61 72 73 65 72 73 20 61 6e 64 20 73 63 61 parsers and sca
d0c0: 6e 6e 65 72 73 0a 3b 0a 3b 20 54 68 65 79 20 70 nners.;.; They p
d0d0: 61 72 73 65 20 70 72 6f 64 75 63 74 69 6f 6e 73 arse productions
d0e0: 20 63 6f 72 72 65 73 70 6f 6e 64 69 6e 67 20 74 corresponding t
d0f0: 6f 20 74 68 65 20 77 68 6f 6c 65 20 28 64 6f 63 o the whole (doc
d100: 75 6d 65 6e 74 29 20 65 6e 74 69 74 79 0a 3b 20 ument) entity.;
d110: 6f 72 20 69 74 73 20 68 69 67 68 65 72 2d 6c 65 or its higher-le
d120: 76 65 6c 20 70 69 65 63 65 73 20 28 70 72 6f 6c vel pieces (prol
d130: 6f 67 2c 20 72 6f 6f 74 20 65 6c 65 6d 65 6e 74 og, root element
d140: 2c 20 65 74 63 29 2e 0a 0a 0a 3b 20 53 63 61 6e , etc)....; Scan
d150: 20 74 68 65 20 4d 69 73 63 20 70 72 6f 64 75 63 the Misc produc
d160: 74 69 6f 6e 20 69 6e 20 74 68 65 20 63 6f 6e 74 tion in the cont
d170: 65 78 74 0a 3b 20 5b 31 5d 20 20 64 6f 63 75 6d ext.; [1] docum
d180: 65 6e 74 20 3a 3a 3d 20 20 70 72 6f 6c 6f 67 20 ent ::= prolog
d190: 65 6c 65 6d 65 6e 74 20 4d 69 73 63 2a 0a 3b 20 element Misc*.;
d1a0: 5b 32 32 5d 20 70 72 6f 6c 6f 67 20 3a 3a 3d 20 [22] prolog ::=
d1b0: 58 4d 4c 44 65 63 6c 3f 20 4d 69 73 63 2a 20 28 XMLDecl? Misc* (
d1c0: 64 6f 63 74 79 70 65 64 65 63 20 6c 20 4d 69 73 doctypedec l Mis
d1d0: 63 2a 29 3f 0a 3b 20 5b 32 37 5d 20 4d 69 73 63 c*)?.; [27] Misc
d1e0: 20 3a 3a 3d 20 43 6f 6d 6d 65 6e 74 20 7c 20 50 ::= Comment | P
d1f0: 49 20 7c 20 20 53 0a 3b 0a 3b 20 54 68 65 20 66 I | S.;.; The f
d200: 6f 6c 6c 6f 77 69 6e 67 20 66 75 6e 63 74 69 6f ollowing functio
d210: 6e 20 73 68 6f 75 6c 64 20 62 65 20 63 61 6c 6c n should be call
d220: 65 64 20 69 6e 20 74 68 65 20 70 72 6f 6c 6f 67 ed in the prolog
d230: 20 6f 72 20 65 70 69 6c 6f 67 20 63 6f 6e 74 65 or epilog conte
d240: 78 74 73 2e 0a 3b 20 49 6e 20 74 68 65 73 65 20 xts..; In these
d250: 63 6f 6e 74 65 78 74 73 2c 20 77 68 69 74 65 73 contexts, whites
d260: 70 61 63 65 73 20 61 72 65 20 63 6f 6d 70 6c 65 paces are comple
d270: 74 65 6c 79 20 69 67 6e 6f 72 65 64 2e 0a 3b 20 tely ignored..;
d280: 54 68 65 20 72 65 74 75 72 6e 20 76 61 6c 75 65 The return value
d290: 20 66 72 6f 6d 20 73 73 61 78 3a 73 63 61 6e 2d from ssax:scan-
d2a0: 4d 69 73 63 20 69 73 20 65 69 74 68 65 72 20 61 Misc is either a
d2b0: 20 50 49 2d 74 6f 6b 65 6e 2c 0a 3b 20 61 20 44 PI-token,.; a D
d2c0: 45 43 4c 2d 74 6f 6b 65 6e 2c 20 61 20 53 54 41 ECL-token, a STA
d2d0: 52 54 20 74 6f 6b 65 6e 2c 20 6f 72 20 45 4f 46 RT token, or EOF
d2e0: 2e 0a 3b 20 43 6f 6d 6d 65 6e 74 73 20 61 72 65 ..; Comments are
d2f0: 20 69 67 6e 6f 72 65 64 20 61 6e 64 20 6e 6f 74 ignored and not
d300: 20 72 65 70 6f 72 74 65 64 2e 0a 0a 28 64 65 66 reported...(def
d310: 69 6e 65 20 28 73 73 61 78 3a 73 63 61 6e 2d 4d ine (ssax:scan-M
d320: 69 73 63 20 70 6f 72 74 29 0a 20 20 28 6c 65 74 isc port). (let
d330: 20 6c 6f 6f 70 20 28 28 63 20 28 73 73 61 78 3a loop ((c (ssax:
d340: 73 6b 69 70 2d 53 20 70 6f 72 74 29 29 29 0a 20 skip-S port))).
d350: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 28 (cond. (
d360: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 63 29 20 (eof-object? c)
d370: 63 29 0a 20 20 20 20 20 20 28 28 6e 6f 74 20 28 c). ((not (
d380: 63 68 61 72 3d 3f 20 63 20 23 5c 3c 29 29 0a 20 char=? c #\<)).
d390: 20 20 20 20 20 20 20 28 70 61 72 73 65 72 2d 65 (parser-e
d3a0: 72 72 6f 72 20 70 6f 72 74 20 22 58 4d 4c 20 5b rror port "XML [
d3b0: 32 32 5d 2c 20 63 68 61 72 20 27 22 20 63 20 22 22], char '" c "
d3c0: 27 20 75 6e 65 78 70 65 63 74 65 64 22 29 29 0a ' unexpected")).
d3d0: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
d3e0: 20 20 20 20 28 6c 65 74 20 28 28 74 6f 6b 65 6e (let ((token
d3f0: 20 28 73 73 61 78 3a 72 65 61 64 2d 6d 61 72 6b (ssax:read-mark
d400: 75 70 2d 74 6f 6b 65 6e 20 70 6f 72 74 29 29 29 up-token port)))
d410: 0a 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 . (case
d420: 20 28 78 6d 6c 2d 74 6f 6b 65 6e 2d 6b 69 6e 64 (xml-token-kind
d430: 20 74 6f 6b 65 6e 29 0a 20 20 20 20 20 20 20 20 token).
d440: 20 20 20 20 28 28 43 4f 4d 4d 45 4e 54 29 20 28 ((COMMENT) (
d450: 6c 6f 6f 70 20 28 73 73 61 78 3a 73 6b 69 70 2d loop (ssax:skip-
d460: 53 20 70 6f 72 74 29 29 29 0a 20 20 20 20 20 20 S port))).
d470: 20 20 20 20 20 20 28 28 50 49 20 44 45 43 4c 20 ((PI DECL
d480: 53 54 41 52 54 29 20 74 6f 6b 65 6e 29 0a 20 20 START) token).
d490: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
d4a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
d4b0: 70 61 72 73 65 72 2d 65 72 72 6f 72 20 70 6f 72 parser-error por
d4c0: 74 20 22 58 4d 4c 20 5b 32 32 5d 2c 20 75 6e 65 t "XML [22], une
d4d0: 78 70 65 63 74 65 64 20 74 6f 6b 65 6e 20 6f 66 xpected token of
d4e0: 20 6b 69 6e 64 20 22 0a 09 09 20 20 20 20 20 28 kind "... (
d4f0: 78 6d 6c 2d 74 6f 6b 65 6e 2d 6b 69 6e 64 20 74 xml-token-kind t
d500: 6f 6b 65 6e 29 0a 09 09 20 20 20 20 20 29 29 29 oken)... )))
d510: 29 29 29 29 29 0a 0a 3b 20 70 72 6f 63 65 64 75 )))))..; procedu
d520: 72 65 2b 3a 09 73 73 61 78 3a 72 65 61 64 2d 63 re+:.ssax:read-c
d530: 68 61 72 2d 64 61 74 61 20 50 4f 52 54 20 45 58 har-data PORT EX
d540: 50 45 43 54 2d 45 4f 46 3f 20 53 54 52 2d 48 41 PECT-EOF? STR-HA
d550: 4e 44 4c 45 52 20 53 45 45 44 0a 3b 0a 3b 20 54 NDLER SEED.;.; T
d560: 68 69 73 20 70 72 6f 63 65 64 75 72 65 20 69 73 his procedure is
d570: 20 74 6f 20 72 65 61 64 20 74 68 65 20 63 68 61 to read the cha
d580: 72 61 63 74 65 72 20 63 6f 6e 74 65 6e 74 20 6f racter content o
d590: 66 20 61 6e 20 58 4d 4c 20 64 6f 63 75 6d 65 6e f an XML documen
d5a0: 74 0a 3b 20 6f 72 20 61 6e 20 58 4d 4c 20 65 6c t.; or an XML el
d5b0: 65 6d 65 6e 74 2e 0a 3b 20 5b 34 33 5d 20 63 6f ement..; [43] co
d5c0: 6e 74 65 6e 74 20 3a 3a 3d 20 0a 3b 09 28 65 6c ntent ::= .;.(el
d5d0: 65 6d 65 6e 74 20 7c 20 43 68 61 72 44 61 74 61 ement | CharData
d5e0: 20 7c 20 52 65 66 65 72 65 6e 63 65 20 7c 20 43 | Reference | C
d5f0: 44 53 65 63 74 20 7c 20 50 49 0a 3b 20 09 7c 20 DSect | PI.; .|
d600: 43 6f 6d 6d 65 6e 74 29 2a 0a 3b 20 54 6f 20 62 Comment)*.; To b
d610: 65 20 6d 6f 72 65 20 70 72 65 63 69 73 65 2c 20 e more precise,
d620: 74 68 65 20 70 72 6f 63 65 64 75 72 65 20 72 65 the procedure re
d630: 61 64 73 20 43 68 61 72 44 61 74 61 2c 20 65 78 ads CharData, ex
d640: 70 61 6e 64 73 20 43 44 53 65 63 74 0a 3b 20 61 pands CDSect.; a
d650: 6e 64 20 63 68 61 72 61 63 74 65 72 20 65 6e 74 nd character ent
d660: 69 74 69 65 73 2c 20 61 6e 64 20 73 6b 69 70 73 ities, and skips
d670: 20 63 6f 6d 6d 65 6e 74 73 2e 20 54 68 65 20 70 comments. The p
d680: 72 6f 63 65 64 75 72 65 20 73 74 6f 70 73 0a 3b rocedure stops.;
d690: 20 61 74 20 61 20 6e 61 6d 65 64 20 72 65 66 65 at a named refe
d6a0: 72 65 6e 63 65 2c 20 45 4f 46 2c 20 61 74 20 74 rence, EOF, at t
d6b0: 68 65 20 62 65 67 69 6e 6e 69 6e 67 20 6f 66 20 he beginning of
d6c0: 61 20 50 49 20 6f 72 20 61 20 73 74 61 72 74 2f a PI or a start/
d6d0: 65 6e 64 20 74 61 67 2e 0a 3b 0a 3b 20 70 6f 72 end tag..;.; por
d6e0: 74 0a 3b 09 61 20 50 4f 52 54 20 74 6f 20 72 65 t.;.a PORT to re
d6f0: 61 64 0a 3b 20 65 78 70 65 63 74 2d 65 6f 66 3f ad.; expect-eof?
d700: 0a 3b 09 61 20 62 6f 6f 6c 65 61 6e 20 69 6e 64 .;.a boolean ind
d710: 69 63 61 74 69 6e 67 20 69 66 20 45 4f 46 20 69 icating if EOF i
d720: 73 20 6e 6f 72 6d 61 6c 2c 20 69 2e 65 2e 2c 20 s normal, i.e.,
d730: 74 68 65 20 63 68 61 72 61 63 74 65 72 0a 3b 09 the character.;.
d740: 64 61 74 61 20 6d 61 79 20 62 65 20 74 65 72 6d data may be term
d750: 69 6e 61 74 65 64 20 62 79 20 74 68 65 20 45 4f inated by the EO
d760: 46 2e 20 45 4f 46 20 69 73 20 6e 6f 72 6d 61 6c F. EOF is normal
d770: 0a 3b 09 77 68 69 6c 65 20 70 72 6f 63 65 73 73 .;.while process
d780: 69 6e 67 20 61 20 70 61 72 73 65 64 20 65 6e 74 ing a parsed ent
d790: 69 74 79 2e 0a 3b 20 73 74 72 2d 68 61 6e 64 6c ity..; str-handl
d7a0: 65 72 0a 3b 09 61 20 53 54 52 2d 48 41 4e 44 4c er.;.a STR-HANDL
d7b0: 45 52 0a 3b 20 73 65 65 64 0a 3b 09 61 6e 20 61 ER.; seed.;.an a
d7c0: 72 67 75 6d 65 6e 74 20 70 61 73 73 65 64 20 74 rgument passed t
d7d0: 6f 20 74 68 65 20 66 69 72 73 74 20 69 6e 76 6f o the first invo
d7e0: 63 61 74 69 6f 6e 20 6f 66 20 53 54 52 2d 48 41 cation of STR-HA
d7f0: 4e 44 4c 45 52 2e 0a 3b 0a 3b 20 54 68 65 20 70 NDLER..;.; The p
d800: 72 6f 63 65 64 75 72 65 20 72 65 74 75 72 6e 73 rocedure returns
d810: 20 74 77 6f 20 72 65 73 75 6c 74 73 3a 20 53 45 two results: SE
d820: 45 44 20 61 6e 64 20 54 4f 4b 45 4e 2e 0a 3b 20 ED and TOKEN..;
d830: 54 68 65 20 53 45 45 44 20 69 73 20 74 68 65 20 The SEED is the
d840: 72 65 73 75 6c 74 20 6f 66 20 74 68 65 20 6c 61 result of the la
d850: 73 74 20 69 6e 76 6f 63 61 74 69 6f 6e 20 6f 66 st invocation of
d860: 20 53 54 52 2d 48 41 4e 44 4c 45 52 2c 20 6f 72 STR-HANDLER, or
d870: 20 74 68 65 0a 3b 20 6f 72 69 67 69 6e 61 6c 20 the.; original
d880: 73 65 65 64 20 69 66 20 53 54 52 2d 48 41 4e 44 seed if STR-HAND
d890: 4c 45 52 20 77 61 73 20 6e 65 76 65 72 20 63 61 LER was never ca
d8a0: 6c 6c 65 64 2e 0a 3b 0a 3b 20 54 4f 4b 45 4e 20 lled..;.; TOKEN
d8b0: 63 61 6e 20 62 65 20 65 69 74 68 65 72 20 61 6e can be either an
d8c0: 20 65 6f 66 2d 6f 62 6a 65 63 74 20 28 74 68 69 eof-object (thi
d8d0: 73 20 63 61 6e 20 68 61 70 70 65 6e 20 6f 6e 6c s can happen onl
d8e0: 79 20 69 66 0a 3b 20 65 78 70 65 63 74 2d 65 6f y if.; expect-eo
d8f0: 66 3f 20 77 61 73 20 23 74 29 2c 20 6f 72 3a 0a f? was #t), or:.
d900: 3b 20 20 20 20 20 2d 20 61 6e 20 78 6d 6c 2d 74 ; - an xml-t
d910: 6f 6b 65 6e 20 64 65 73 63 72 69 62 69 6e 67 20 oken describing
d920: 61 20 53 54 41 52 54 20 74 61 67 20 6f 72 20 61 a START tag or a
d930: 6e 20 45 4e 44 2d 74 61 67 3b 0a 3b 09 46 6f 72 n END-tag;.;.For
d940: 20 61 20 73 74 61 72 74 20 74 6f 6b 65 6e 2c 20 a start token,
d950: 74 68 65 20 63 61 6c 6c 65 72 20 68 61 73 20 74 the caller has t
d960: 6f 20 66 69 6e 69 73 68 20 72 65 61 64 69 6e 67 o finish reading
d970: 20 69 74 2e 0a 3b 20 20 20 20 20 2d 20 61 6e 20 it..; - an
d980: 78 6d 6c 2d 74 6f 6b 65 6e 20 64 65 73 63 72 69 xml-token descri
d990: 62 69 6e 67 20 74 68 65 20 62 65 67 69 6e 6e 69 bing the beginni
d9a0: 6e 67 20 6f 66 20 61 20 50 49 2e 20 49 74 27 73 ng of a PI. It's
d9b0: 20 75 70 20 74 6f 20 61 6e 0a 3b 09 61 70 70 6c up to an.;.appl
d9c0: 69 63 61 74 69 6f 6e 20 74 6f 20 72 65 61 64 20 ication to read
d9d0: 6f 72 20 73 6b 69 70 20 74 68 72 6f 75 67 68 20 or skip through
d9e0: 74 68 65 20 72 65 73 74 20 6f 66 20 74 68 69 73 the rest of this
d9f0: 20 50 49 3b 0a 3b 20 20 20 20 20 2d 20 61 6e 20 PI;.; - an
da00: 78 6d 6c 2d 74 6f 6b 65 6e 20 64 65 73 63 72 69 xml-token descri
da10: 62 69 6e 67 20 61 20 6e 61 6d 65 64 20 65 6e 74 bing a named ent
da20: 69 74 79 20 72 65 66 65 72 65 6e 63 65 2e 0a 3b ity reference..;
da30: 0a 3b 20 43 44 41 54 41 20 73 65 63 74 69 6f 6e .; CDATA section
da40: 73 20 61 6e 64 20 63 68 61 72 61 63 74 65 72 20 s and character
da50: 72 65 66 65 72 65 6e 63 65 73 20 61 72 65 20 65 references are e
da60: 78 70 61 6e 64 65 64 20 69 6e 6c 69 6e 65 20 61 xpanded inline a
da70: 6e 64 0a 3b 20 6e 65 76 65 72 20 72 65 74 75 72 nd.; never retur
da80: 6e 65 64 2e 20 43 6f 6d 6d 65 6e 74 73 20 61 72 ned. Comments ar
da90: 65 20 73 69 6c 65 6e 74 6c 79 20 64 69 73 72 65 e silently disre
daa0: 67 61 72 64 65 64 2e 0a 3b 0a 3b 20 41 73 20 74 garded..;.; As t
dab0: 68 65 20 58 4d 4c 20 52 65 63 6f 6d 6d 65 6e 64 he XML Recommend
dac0: 61 74 69 6f 6e 20 72 65 71 75 69 72 65 73 2c 20 ation requires,
dad0: 61 6c 6c 20 77 68 69 74 65 73 70 61 63 65 20 69 all whitespace i
dae0: 6e 20 63 68 61 72 61 63 74 65 72 20 64 61 74 61 n character data
daf0: 0a 3b 20 6d 75 73 74 20 62 65 20 70 72 65 73 65 .; must be prese
db00: 72 76 65 64 2e 20 48 6f 77 65 76 65 72 2c 20 61 rved. However, a
db10: 20 43 52 20 63 68 61 72 61 63 74 65 72 20 28 23 CR character (#
db20: 78 44 29 20 6d 75 73 74 20 62 65 20 64 69 73 72 xD) must be disr
db30: 65 67 61 72 64 65 64 0a 3b 20 69 66 20 69 74 20 egarded.; if it
db40: 61 70 70 65 61 72 73 20 62 65 66 6f 72 65 20 61 appears before a
db50: 20 4c 46 20 63 68 61 72 61 63 74 65 72 20 28 23 LF character (#
db60: 78 41 29 2c 20 6f 72 20 72 65 70 6c 61 63 65 64 xA), or replaced
db70: 20 62 79 20 61 20 23 78 41 20 63 68 61 72 61 63 by a #xA charac
db80: 74 65 72 0a 3b 20 6f 74 68 65 72 77 69 73 65 2e ter.; otherwise.
db90: 20 53 65 65 20 53 65 63 73 2e 20 32 2e 31 30 20 See Secs. 2.10
dba0: 61 6e 64 20 32 2e 31 31 20 6f 66 20 74 68 65 20 and 2.11 of the
dbb0: 58 4d 4c 20 52 65 63 6f 6d 6d 65 6e 64 61 74 69 XML Recommendati
dbc0: 6f 6e 2e 20 53 65 65 20 61 6c 73 6f 0a 3b 20 74 on. See also.; t
dbd0: 68 65 20 63 61 6e 6f 6e 69 63 61 6c 20 58 4d 4c he canonical XML
dbe0: 20 52 65 63 6f 6d 6d 65 6e 64 61 74 69 6f 6e 2e Recommendation.
dbf0: 0a 0a 09 3b 20 73 73 61 78 3a 72 65 61 64 2d 63 ...; ssax:read-c
dc00: 68 61 72 2d 64 61 74 61 20 70 6f 72 74 20 65 78 har-data port ex
dc10: 70 65 63 74 2d 65 6f 66 3f 20 73 74 72 2d 68 61 pect-eof? str-ha
dc20: 6e 64 6c 65 72 20 73 65 65 64 0a 28 64 65 66 69 ndler seed.(defi
dc30: 6e 65 20 73 73 61 78 3a 72 65 61 64 2d 63 68 61 ne ssax:read-cha
dc40: 72 2d 64 61 74 61 0a 20 28 6c 65 74 0a 20 20 20 r-data. (let.
dc50: 20 20 28 28 74 65 72 6d 69 6e 61 74 6f 72 73 2d ((terminators-
dc60: 75 73 75 61 6c 20 28 6c 69 73 74 20 23 5c 3c 20 usual (list #\<
dc70: 23 5c 26 20 63 68 61 72 2d 72 65 74 75 72 6e 29 #\& char-return)
dc80: 29 0a 20 20 20 20 20 20 28 74 65 72 6d 69 6e 61 ). (termina
dc90: 74 6f 72 73 2d 75 73 75 61 6c 2d 65 6f 66 20 28 tors-usual-eof (
dca0: 6c 69 73 74 20 23 5c 3c 20 27 2a 65 6f 66 2a 20 list #\< '*eof*
dcb0: 23 5c 26 20 63 68 61 72 2d 72 65 74 75 72 6e 29 #\& char-return)
dcc0: 29 0a 0a 20 20 20 20 20 20 28 68 61 6e 64 6c 65 ).. (handle
dcd0: 2d 66 72 61 67 6d 65 6e 74 0a 20 20 20 20 20 20 -fragment.
dce0: 20 28 6c 61 6d 62 64 61 20 28 66 72 61 67 6d 65 (lambda (fragme
dcf0: 6e 74 20 73 74 72 2d 68 61 6e 64 6c 65 72 20 73 nt str-handler s
dd00: 65 65 64 29 0a 09 20 28 69 66 20 28 73 74 72 69 eed).. (if (stri
dd10: 6e 67 2d 6e 75 6c 6c 3f 20 66 72 61 67 6d 65 6e ng-null? fragmen
dd20: 74 29 20 73 65 65 64 0a 09 20 20 20 20 20 28 73 t) seed.. (s
dd30: 74 72 2d 68 61 6e 64 6c 65 72 20 66 72 61 67 6d tr-handler fragm
dd40: 65 6e 74 20 22 22 20 73 65 65 64 29 29 29 29 0a ent "" seed)))).
dd50: 20 20 20 20 20 20 29 0a 0a 20 20 20 28 6c 61 6d ).. (lam
dd60: 62 64 61 20 28 70 6f 72 74 20 65 78 70 65 63 74 bda (port expect
dd70: 2d 65 6f 66 3f 20 73 74 72 2d 68 61 6e 64 6c 65 -eof? str-handle
dd80: 72 20 73 65 65 64 29 0a 0a 20 20 20 20 20 3b 20 r seed).. ;
dd90: 56 65 72 79 20 6f 66 74 65 6e 2c 20 74 68 65 20 Very often, the
dda0: 66 69 72 73 74 20 63 68 61 72 61 63 74 65 72 20 first character
ddb0: 77 65 20 65 6e 63 6f 75 6e 74 65 72 20 69 73 20 we encounter is
ddc0: 23 5c 3c 0a 20 20 20 20 20 3b 20 54 68 65 72 65 #\<. ; There
ddd0: 66 6f 72 65 2c 20 77 65 20 68 61 6e 64 6c 65 20 fore, we handle
dde0: 74 68 69 73 20 63 61 73 65 20 69 6e 20 61 20 73 this case in a s
ddf0: 70 65 63 69 61 6c 2c 20 66 61 73 74 20 70 61 74 pecial, fast pat
de00: 68 0a 20 20 20 20 20 28 69 66 20 28 65 71 76 3f h. (if (eqv?
de10: 20 23 5c 3c 20 28 70 65 65 6b 2d 63 68 61 72 20 #\< (peek-char
de20: 70 6f 72 74 29 29 0a 0a 20 20 20 20 20 20 20 20 port))..
de30: 20 3b 20 54 68 65 20 66 61 73 74 20 70 61 74 68 ; The fast path
de40: 0a 09 20 28 6c 65 74 20 28 28 74 6f 6b 65 6e 20 .. (let ((token
de50: 28 73 73 61 78 3a 72 65 61 64 2d 6d 61 72 6b 75 (ssax:read-marku
de60: 70 2d 74 6f 6b 65 6e 20 70 6f 72 74 29 29 29 0a p-token port))).
de70: 09 20 20 20 28 63 61 73 65 20 28 78 6d 6c 2d 74 . (case (xml-t
de80: 6f 6b 65 6e 2d 6b 69 6e 64 20 74 6f 6b 65 6e 29 oken-kind token)
de90: 0a 09 20 20 20 20 20 28 28 53 54 41 52 54 20 45 .. ((START E
dea0: 4e 44 29 09 3b 20 54 68 65 20 6d 6f 73 74 20 63 ND).; The most c
deb0: 6f 6d 6d 6f 6e 20 63 61 73 65 0a 09 20 20 20 20 ommon case..
dec0: 20 20 28 76 61 6c 75 65 73 20 73 65 65 64 20 74 (values seed t
ded0: 6f 6b 65 6e 29 29 0a 09 20 20 20 20 20 28 28 43 oken)).. ((C
dee0: 44 53 45 43 54 29 0a 09 20 20 20 20 20 20 28 6c DSECT).. (l
def0: 65 74 20 28 28 73 65 65 64 20 28 73 73 61 78 3a et ((seed (ssax:
df00: 72 65 61 64 2d 63 64 61 74 61 2d 62 6f 64 79 20 read-cdata-body
df10: 70 6f 72 74 20 73 74 72 2d 68 61 6e 64 6c 65 72 port str-handler
df20: 20 73 65 65 64 29 29 29 0a 09 09 28 73 73 61 78 seed)))...(ssax
df30: 3a 72 65 61 64 2d 63 68 61 72 2d 64 61 74 61 20 :read-char-data
df40: 70 6f 72 74 20 65 78 70 65 63 74 2d 65 6f 66 3f port expect-eof?
df50: 20 73 74 72 2d 68 61 6e 64 6c 65 72 20 73 65 65 str-handler see
df60: 64 29 29 29 0a 09 20 20 20 20 20 28 28 43 4f 4d d))).. ((COM
df70: 4d 45 4e 54 29 20 28 73 73 61 78 3a 72 65 61 64 MENT) (ssax:read
df80: 2d 63 68 61 72 2d 64 61 74 61 20 70 6f 72 74 20 -char-data port
df90: 65 78 70 65 63 74 2d 65 6f 66 3f 0a 09 09 09 09 expect-eof?.....
dfa0: 09 20 20 20 20 20 73 74 72 2d 68 61 6e 64 6c 65 . str-handle
dfb0: 72 20 73 65 65 64 29 29 0a 09 20 20 20 20 20 28 r seed)).. (
dfc0: 65 6c 73 65 0a 09 20 20 20 20 20 20 28 76 61 6c else.. (val
dfd0: 75 65 73 20 73 65 65 64 20 74 6f 6b 65 6e 29 29 ues seed token))
dfe0: 29 29 0a 0a 0a 20 20 20 20 20 20 20 20 20 3b 20 ))... ;
dff0: 54 68 65 20 73 6c 6f 77 20 70 61 74 68 0a 09 20 The slow path..
e000: 28 6c 65 74 20 28 28 63 68 61 72 2d 64 61 74 61 (let ((char-data
e010: 2d 74 65 72 6d 69 6e 61 74 6f 72 73 0a 09 09 28 -terminators...(
e020: 69 66 20 65 78 70 65 63 74 2d 65 6f 66 3f 20 74 if expect-eof? t
e030: 65 72 6d 69 6e 61 74 6f 72 73 2d 75 73 75 61 6c erminators-usual
e040: 2d 65 6f 66 20 74 65 72 6d 69 6e 61 74 6f 72 73 -eof terminators
e050: 2d 75 73 75 61 6c 29 29 29 0a 0a 09 20 20 20 28 -usual)))... (
e060: 6c 65 74 20 6c 6f 6f 70 20 28 28 73 65 65 64 20 let loop ((seed
e070: 73 65 65 64 29 29 0a 09 20 20 20 20 20 28 6c 65 seed)).. (le
e080: 74 2a 20 28 28 66 72 61 67 6d 65 6e 74 0a 09 09 t* ((fragment...
e090: 20 20 20 20 20 28 6e 65 78 74 2d 74 6f 6b 65 6e (next-token
e0a0: 20 27 28 29 20 63 68 61 72 2d 64 61 74 61 2d 74 '() char-data-t
e0b0: 65 72 6d 69 6e 61 74 6f 72 73 20 0a 09 09 09 09 erminators .....
e0c0: 20 22 72 65 61 64 69 6e 67 20 63 68 61 72 20 64 "reading char d
e0d0: 61 74 61 22 20 70 6f 72 74 29 29 0a 09 09 20 20 ata" port))...
e0e0: 20 20 28 74 65 72 6d 2d 63 68 61 72 20 28 70 65 (term-char (pe
e0f0: 65 6b 2d 63 68 61 72 20 70 6f 72 74 29 29 20 3b ek-char port)) ;
e100: 20 6f 6e 65 20 6f 66 20 63 68 61 72 2d 64 61 74 one of char-dat
e110: 61 2d 74 65 72 6d 69 6e 61 74 6f 72 73 0a 09 09 a-terminators...
e120: 20 20 20 20 29 0a 09 20 20 20 20 20 20 20 28 69 ).. (i
e130: 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 74 f (eof-object? t
e140: 65 72 6d 2d 63 68 61 72 29 0a 09 09 20 20 20 28 erm-char)... (
e150: 76 61 6c 75 65 73 0a 09 09 20 20 20 20 28 68 61 values... (ha
e160: 6e 64 6c 65 2d 66 72 61 67 6d 65 6e 74 20 66 72 ndle-fragment fr
e170: 61 67 6d 65 6e 74 20 73 74 72 2d 68 61 6e 64 6c agment str-handl
e180: 65 72 20 73 65 65 64 29 0a 09 09 20 20 20 20 74 er seed)... t
e190: 65 72 6d 2d 63 68 61 72 29 0a 09 09 20 20 20 28 erm-char)... (
e1a0: 63 61 73 65 20 74 65 72 6d 2d 63 68 61 72 0a 09 case term-char..
e1b0: 09 20 20 20 20 20 28 28 23 5c 3c 29 0a 09 09 20 . ((#\<)...
e1c0: 20 20 20 20 20 28 6c 65 74 20 28 28 74 6f 6b 65 (let ((toke
e1d0: 6e 20 28 73 73 61 78 3a 72 65 61 64 2d 6d 61 72 n (ssax:read-mar
e1e0: 6b 75 70 2d 74 6f 6b 65 6e 20 70 6f 72 74 29 29 kup-token port))
e1f0: 29 0a 09 09 09 28 63 61 73 65 20 28 78 6d 6c 2d )....(case (xml-
e200: 74 6f 6b 65 6e 2d 6b 69 6e 64 20 74 6f 6b 65 6e token-kind token
e210: 29 0a 09 09 09 20 20 28 28 43 44 53 45 43 54 29 ).... ((CDSECT)
e220: 0a 09 09 09 20 20 20 28 6c 6f 6f 70 0a 09 09 09 .... (loop....
e230: 20 20 20 20 28 73 73 61 78 3a 72 65 61 64 2d 63 (ssax:read-c
e240: 64 61 74 61 2d 62 6f 64 79 20 70 6f 72 74 20 73 data-body port s
e250: 74 72 2d 68 61 6e 64 6c 65 72 0a 09 09 09 20 20 tr-handler....
e260: 20 20 20 20 20 20 28 68 61 6e 64 6c 65 2d 66 72 (handle-fr
e270: 61 67 6d 65 6e 74 20 66 72 61 67 6d 65 6e 74 20 agment fragment
e280: 73 74 72 2d 68 61 6e 64 6c 65 72 20 73 65 65 64 str-handler seed
e290: 29 29 29 29 0a 09 09 09 20 20 28 28 43 4f 4d 4d )))).... ((COMM
e2a0: 45 4e 54 29 0a 09 09 09 20 20 20 28 6c 6f 6f 70 ENT).... (loop
e2b0: 20 28 68 61 6e 64 6c 65 2d 66 72 61 67 6d 65 6e (handle-fragmen
e2c0: 74 20 66 72 61 67 6d 65 6e 74 20 73 74 72 2d 68 t fragment str-h
e2d0: 61 6e 64 6c 65 72 20 73 65 65 64 29 29 29 0a 09 andler seed)))..
e2e0: 09 09 20 20 28 65 6c 73 65 0a 09 09 09 20 20 20 .. (else....
e2f0: 28 76 61 6c 75 65 73 0a 09 09 09 20 20 20 20 28 (values.... (
e300: 68 61 6e 64 6c 65 2d 66 72 61 67 6d 65 6e 74 20 handle-fragment
e310: 66 72 61 67 6d 65 6e 74 20 73 74 72 2d 68 61 6e fragment str-han
e320: 64 6c 65 72 20 73 65 65 64 29 0a 09 09 09 20 20 dler seed)....
e330: 20 20 74 6f 6b 65 6e 29 29 29 29 29 0a 09 09 20 token)))))...
e340: 20 20 20 20 28 28 23 5c 26 29 0a 09 09 20 20 20 ((#\&)...
e350: 20 20 20 28 63 61 73 65 20 28 70 65 65 6b 2d 6e (case (peek-n
e360: 65 78 74 2d 63 68 61 72 20 70 6f 72 74 29 0a 09 ext-char port)..
e370: 09 09 28 28 23 5c 23 29 20 28 72 65 61 64 2d 63 ..((#\#) (read-c
e380: 68 61 72 20 70 6f 72 74 29 20 0a 09 09 09 20 28 har port) .... (
e390: 6c 6f 6f 70 20 28 73 74 72 2d 68 61 6e 64 6c 65 loop (str-handle
e3a0: 72 20 66 72 61 67 6d 65 6e 74 0a 09 09 09 09 20 r fragment.....
e3b0: 20 20 20 20 20 20 28 73 74 72 69 6e 67 20 28 73 (string (s
e3c0: 73 61 78 3a 72 65 61 64 2d 63 68 61 72 2d 72 65 sax:read-char-re
e3d0: 66 20 70 6f 72 74 29 29 0a 09 09 09 09 20 20 20 f port)).....
e3e0: 20 20 20 20 73 65 65 64 29 29 29 0a 09 09 09 28 seed)))....(
e3f0: 65 6c 73 65 0a 09 09 09 20 28 6c 65 74 20 28 28 else.... (let ((
e400: 6e 61 6d 65 20 28 73 73 61 78 3a 72 65 61 64 2d name (ssax:read-
e410: 4e 43 4e 61 6d 65 20 70 6f 72 74 29 29 29 0a 09 NCName port)))..
e420: 09 09 20 20 20 28 61 73 73 65 72 74 2d 63 75 72 .. (assert-cur
e430: 72 2d 63 68 61 72 20 27 28 23 5c 3b 29 20 22 58 r-char '(#\;) "X
e440: 4d 4c 20 5b 36 38 5d 22 20 70 6f 72 74 29 0a 09 ML [68]" port)..
e450: 09 09 20 20 20 28 76 61 6c 75 65 73 0a 09 09 09 .. (values....
e460: 20 20 20 20 28 68 61 6e 64 6c 65 2d 66 72 61 67 (handle-frag
e470: 6d 65 6e 74 20 66 72 61 67 6d 65 6e 74 20 73 74 ment fragment st
e480: 72 2d 68 61 6e 64 6c 65 72 20 73 65 65 64 29 0a r-handler seed).
e490: 09 09 09 20 20 20 20 28 6d 61 6b 65 2d 78 6d 6c ... (make-xml
e4a0: 2d 74 6f 6b 65 6e 20 27 45 4e 54 49 54 59 2d 52 -token 'ENTITY-R
e4b0: 45 46 20 6e 61 6d 65 29 29 29 29 29 29 0a 09 09 EF name))))))...
e4c0: 20 20 20 20 20 28 65 6c 73 65 09 09 3b 20 54 68 (else..; Th
e4d0: 69 73 20 6d 75 73 74 20 62 65 20 61 20 43 52 20 is must be a CR
e4e0: 63 68 61 72 61 63 74 65 72 0a 09 09 20 20 20 20 character...
e4f0: 20 20 28 69 66 20 28 65 71 76 3f 20 28 70 65 65 (if (eqv? (pee
e500: 6b 2d 6e 65 78 74 2d 63 68 61 72 20 70 6f 72 74 k-next-char port
e510: 29 20 23 5c 6e 65 77 6c 69 6e 65 29 0a 09 09 09 ) #\newline)....
e520: 20 20 28 72 65 61 64 2d 63 68 61 72 20 70 6f 72 (read-char por
e530: 74 29 29 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f t))... (loo
e540: 70 20 28 73 74 72 2d 68 61 6e 64 6c 65 72 20 66 p (str-handler f
e550: 72 61 67 6d 65 6e 74 20 28 73 74 72 69 6e 67 20 ragment (string
e560: 23 5c 6e 65 77 6c 69 6e 65 29 20 73 65 65 64 29 #\newline) seed)
e570: 29 29 29 0a 09 09 20 20 20 29 29 29 29 29 29 29 )))... )))))))
e580: 29 0a 0a 0a 3b 20 70 72 6f 63 65 64 75 72 65 2b )...; procedure+
e590: 3a 09 73 73 61 78 3a 61 73 73 65 72 74 2d 74 6f :.ssax:assert-to
e5a0: 6b 65 6e 20 54 4f 4b 45 4e 20 4b 49 4e 44 20 47 ken TOKEN KIND G
e5b0: 49 0a 3b 20 4d 61 6b 65 20 73 75 72 65 20 74 68 I.; Make sure th
e5c0: 61 74 20 54 4f 4b 45 4e 20 69 73 20 6f 66 20 61 at TOKEN is of a
e5d0: 6e 74 69 63 69 70 61 74 65 64 20 4b 49 4e 44 20 nticipated KIND
e5e0: 61 6e 64 20 68 61 73 20 61 6e 74 69 63 69 70 61 and has anticipa
e5f0: 74 65 64 20 47 49 0a 3b 20 4e 6f 74 65 20 47 49 ted GI.; Note GI
e600: 20 61 72 67 75 6d 65 6e 74 20 6d 61 79 20 61 63 argument may ac
e610: 74 75 61 6c 6c 79 20 62 65 20 61 20 70 61 69 72 tually be a pair
e620: 20 6f 66 20 74 77 6f 20 73 79 6d 62 6f 6c 73 2c of two symbols,
e630: 20 4e 61 6d 65 73 70 61 63 65 0a 3b 20 55 52 49 Namespace.; URI
e640: 20 6f 72 20 74 68 65 20 70 72 65 66 69 78 2c 20 or the prefix,
e650: 61 6e 64 20 6f 66 20 74 68 65 20 6c 6f 63 61 6c and of the local
e660: 6e 61 6d 65 2e 0a 3b 20 49 66 20 74 68 65 20 61 name..; If the a
e670: 73 73 65 72 74 69 6f 6e 20 66 61 69 6c 73 2c 20 ssertion fails,
e680: 65 72 72 6f 72 2d 63 6f 6e 74 20 69 73 20 65 76 error-cont is ev
e690: 61 6c 75 61 74 65 64 20 62 79 20 70 61 73 73 69 aluated by passi
e6a0: 6e 67 20 69 74 0a 3b 20 74 68 72 65 65 20 61 72 ng it.; three ar
e6b0: 67 75 6d 65 6e 74 73 3a 20 74 6f 6b 65 6e 20 6b guments: token k
e6c0: 69 6e 64 20 67 69 2e 20 54 68 65 20 72 65 73 75 ind gi. The resu
e6d0: 6c 74 20 6f 66 20 65 72 72 6f 72 2d 63 6f 6e 74 lt of error-cont
e6e0: 20 69 73 20 72 65 74 75 72 6e 65 64 2e 0a 28 64 is returned..(d
e6f0: 65 66 69 6e 65 20 28 73 73 61 78 3a 61 73 73 65 efine (ssax:asse
e700: 72 74 2d 74 6f 6b 65 6e 20 74 6f 6b 65 6e 20 6b rt-token token k
e710: 69 6e 64 20 67 69 20 65 72 72 6f 72 2d 63 6f 6e ind gi error-con
e720: 74 29 0a 20 20 28 6f 72 0a 20 20 20 20 28 61 6e t). (or. (an
e730: 64 20 28 78 6d 6c 2d 74 6f 6b 65 6e 3f 20 74 6f d (xml-token? to
e740: 6b 65 6e 29 0a 20 20 20 20 20 20 28 65 71 3f 20 ken). (eq?
e750: 6b 69 6e 64 20 28 78 6d 6c 2d 74 6f 6b 65 6e 2d kind (xml-token-
e760: 6b 69 6e 64 20 74 6f 6b 65 6e 29 29 0a 20 20 20 kind token)).
e770: 20 20 20 28 65 71 75 61 6c 3f 20 67 69 20 28 78 (equal? gi (x
e780: 6d 6c 2d 74 6f 6b 65 6e 2d 68 65 61 64 20 74 6f ml-token-head to
e790: 6b 65 6e 29 29 29 0a 20 20 20 20 28 65 72 72 6f ken))). (erro
e7a0: 72 2d 63 6f 6e 74 20 74 6f 6b 65 6e 20 6b 69 6e r-cont token kin
e7b0: 64 20 67 69 29 29 29 0a 0a 3b 3d 3d 3d 3d 3d 3d d gi)))..;======
e7c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e7d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e7e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e7f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e800: 3d 3d 0a 3b 09 09 48 69 67 68 65 73 74 2d 6c 65 ==.;..Highest-le
e810: 76 65 6c 20 70 61 72 73 65 72 73 3a 20 58 4d 4c vel parsers: XML
e820: 20 74 6f 20 53 58 4d 4c 0a 0a 3b 20 54 68 65 73 to SXML..; Thes
e830: 65 20 70 61 72 73 65 72 73 20 61 72 65 20 61 20 e parsers are a
e840: 73 65 74 20 6f 66 20 73 79 6e 74 61 63 74 69 63 set of syntactic
e850: 20 66 6f 72 6d 73 20 74 6f 20 69 6e 73 74 61 6e forms to instan
e860: 74 69 61 74 65 20 61 20 53 53 41 58 20 70 61 72 tiate a SSAX par
e870: 73 65 72 2e 0a 3b 20 41 20 75 73 65 72 20 63 61 ser..; A user ca
e880: 6e 20 69 6e 73 74 61 6e 74 69 61 74 65 20 74 68 n instantiate th
e890: 65 20 70 61 72 73 65 72 20 74 6f 20 64 6f 20 74 e parser to do t
e8a0: 68 65 20 66 75 6c 6c 20 76 61 6c 69 64 61 74 69 he full validati
e8b0: 6f 6e 2c 20 6f 72 0a 3b 20 6e 6f 20 76 61 6c 69 on, or.; no vali
e8c0: 64 61 74 69 6f 6e 2c 20 6f 72 20 61 6e 79 20 70 dation, or any p
e8d0: 61 72 74 69 63 75 6c 61 72 20 76 61 6c 69 64 61 articular valida
e8e0: 74 69 6f 6e 2e 20 54 68 65 20 75 73 65 72 20 73 tion. The user s
e8f0: 70 65 63 69 66 69 65 73 0a 3b 20 77 68 69 63 68 pecifies.; which
e900: 20 50 49 20 68 65 20 77 61 6e 74 73 20 74 6f 20 PI he wants to
e910: 62 65 20 6e 6f 74 69 66 69 65 64 20 61 62 6f 75 be notified abou
e920: 74 2e 20 54 68 65 20 75 73 65 72 20 74 65 6c 6c t. The user tell
e930: 73 20 77 68 61 74 20 74 6f 20 64 6f 0a 3b 20 77 s what to do.; w
e940: 69 74 68 20 74 68 65 20 70 61 72 73 65 64 20 63 ith the parsed c
e950: 68 61 72 61 63 74 65 72 20 61 6e 64 20 65 6c 65 haracter and ele
e960: 6d 65 6e 74 20 64 61 74 61 2e 20 54 68 65 20 6c ment data. The l
e970: 61 74 74 65 72 20 68 61 6e 64 6c 65 72 73 0a 3b atter handlers.;
e980: 20 64 65 74 65 72 6d 69 6e 65 20 69 66 20 74 68 determine if th
e990: 65 20 70 61 72 73 69 6e 67 20 66 6f 6c 6c 6f 77 e parsing follow
e9a0: 73 20 61 20 53 41 58 20 6f 72 20 61 20 44 4f 4d s a SAX or a DOM
e9b0: 20 6d 6f 64 65 6c 2e 0a 0a 3b 20 73 79 6e 74 61 model...; synta
e9c0: 78 3a 20 73 73 61 78 3a 6d 61 6b 65 2d 70 69 2d x: ssax:make-pi-
e9d0: 70 61 72 73 65 72 20 6d 79 2d 70 69 2d 68 61 6e parser my-pi-han
e9e0: 64 6c 65 72 73 0a 3b 20 43 72 65 61 74 65 20 61 dlers.; Create a
e9f0: 20 70 61 72 73 65 72 20 74 6f 20 70 61 72 73 65 parser to parse
ea00: 20 61 6e 64 20 70 72 6f 63 65 73 73 20 6f 6e 65 and process one
ea10: 20 50 72 6f 63 65 73 73 69 6e 67 20 45 6c 65 6d Processing Elem
ea20: 65 6e 74 20 28 50 49 29 2e 0a 0a 3b 20 6d 79 2d ent (PI)...; my-
ea30: 70 69 2d 68 61 6e 64 6c 65 72 73 0a 3b 09 41 6e pi-handlers.;.An
ea40: 20 61 73 73 6f 63 20 6c 69 73 74 20 6f 66 20 70 assoc list of p
ea50: 61 69 72 73 20 28 50 49 2d 54 41 47 20 2e 20 50 airs (PI-TAG . P
ea60: 49 2d 48 41 4e 44 4c 45 52 29 0a 3b 09 77 68 65 I-HANDLER).;.whe
ea70: 72 65 20 50 49 2d 54 41 47 20 69 73 20 61 6e 20 re PI-TAG is an
ea80: 4e 43 4e 61 6d 65 20 73 79 6d 62 6f 6c 2c 20 74 NCName symbol, t
ea90: 68 65 20 50 49 20 74 61 72 67 65 74 2c 20 61 6e he PI target, an
eaa0: 64 0a 3b 09 50 49 2d 48 41 4e 44 4c 45 52 20 69 d.;.PI-HANDLER i
eab0: 73 20 61 20 70 72 6f 63 65 64 75 72 65 20 50 4f s a procedure PO
eac0: 52 54 20 50 49 2d 54 41 47 20 53 45 45 44 0a 3b RT PI-TAG SEED.;
ead0: 09 77 68 65 72 65 20 50 4f 52 54 20 70 6f 69 6e .where PORT poin
eae0: 74 73 20 74 6f 20 74 68 65 20 66 69 72 73 74 20 ts to the first
eaf0: 73 79 6d 62 6f 6c 20 61 66 74 65 72 20 74 68 65 symbol after the
eb00: 20 50 49 20 74 61 72 67 65 74 2e 0a 3b 09 54 68 PI target..;.Th
eb10: 65 20 68 61 6e 64 6c 65 72 20 73 68 6f 75 6c 64 e handler should
eb20: 20 72 65 61 64 20 74 68 65 20 72 65 73 74 20 6f read the rest o
eb30: 66 20 74 68 65 20 50 49 20 75 70 20 74 6f 20 61 f the PI up to a
eb40: 6e 64 20 69 6e 63 6c 75 64 69 6e 67 0a 3b 09 74 nd including.;.t
eb50: 68 65 20 63 6f 6d 62 69 6e 61 74 69 6f 6e 20 27 he combination '
eb60: 3f 3e 27 20 74 68 61 74 20 74 65 72 6d 69 6e 61 ?>' that termina
eb70: 74 65 73 20 74 68 65 20 50 49 2e 20 54 68 65 20 tes the PI. The
eb80: 68 61 6e 64 6c 65 72 20 73 68 6f 75 6c 64 0a 3b handler should.;
eb90: 09 72 65 74 75 72 6e 20 61 20 6e 65 77 20 73 65 .return a new se
eba0: 65 64 2e 0a 3b 09 4f 6e 65 20 6f 66 20 74 68 65 ed..;.One of the
ebb0: 20 50 49 2d 54 41 47 73 20 6d 61 79 20 62 65 20 PI-TAGs may be
ebc0: 74 68 65 20 73 79 6d 62 6f 6c 20 2a 44 45 46 41 the symbol *DEFA
ebd0: 55 4c 54 2a 2e 20 54 68 65 20 63 6f 72 72 65 73 ULT*. The corres
ebe0: 70 6f 6e 64 69 6e 67 0a 3b 09 68 61 6e 64 6c 65 ponding.;.handle
ebf0: 72 20 77 69 6c 6c 20 68 61 6e 64 6c 65 20 50 49 r will handle PI
ec00: 73 20 74 68 61 74 20 6e 6f 20 6f 74 68 65 72 20 s that no other
ec10: 68 61 6e 64 6c 65 72 20 77 69 6c 6c 2e 20 49 66 handler will. If
ec20: 20 74 68 65 0a 3b 09 2a 44 45 46 41 55 4c 54 2a the.;.*DEFAULT*
ec30: 20 50 49 2d 54 41 47 20 69 73 20 6e 6f 74 20 73 PI-TAG is not s
ec40: 70 65 63 69 66 69 65 64 2c 20 73 73 61 78 3a 6d pecified, ssax:m
ec50: 61 6b 65 2d 70 69 2d 70 61 72 73 65 72 20 77 69 ake-pi-parser wi
ec60: 6c 6c 20 61 73 73 75 6d 65 0a 3b 09 74 68 65 20 ll assume.;.the
ec70: 64 65 66 61 75 6c 74 20 68 61 6e 64 6c 65 72 20 default handler
ec80: 74 68 61 74 20 73 6b 69 70 73 20 74 68 65 20 62 that skips the b
ec90: 6f 64 79 20 6f 66 20 74 68 65 20 50 49 0a 3b 09 ody of the PI.;.
eca0: 0a 3b 20 54 68 65 20 6f 75 74 70 75 74 20 6f 66 .; The output of
ecb0: 20 74 68 65 20 73 73 61 78 3a 6d 61 6b 65 2d 70 the ssax:make-p
ecc0: 69 2d 70 61 72 73 65 72 20 69 73 20 61 20 70 72 i-parser is a pr
ecd0: 6f 63 65 64 75 72 65 0a 3b 09 50 4f 52 54 20 50 ocedure.;.PORT P
ece0: 49 2d 54 41 47 20 53 45 45 44 0a 3b 20 74 68 61 I-TAG SEED.; tha
ecf0: 74 20 77 69 6c 6c 20 70 61 72 73 65 20 74 68 65 t will parse the
ed00: 20 63 75 72 72 65 6e 74 20 50 49 20 61 63 63 6f current PI acco
ed10: 72 64 69 6e 67 20 74 6f 20 74 68 65 20 75 73 65 rding to the use
ed20: 72 2d 73 70 65 63 69 66 69 65 64 20 68 61 6e 64 r-specified hand
ed30: 6c 65 72 73 2e 0a 3b 0a 3b 20 54 68 65 20 70 72 lers..;.; The pr
ed40: 65 76 69 6f 75 73 20 76 65 72 73 69 6f 6e 20 6f evious version o
ed50: 66 20 73 73 61 78 3a 6d 61 6b 65 2d 70 69 2d 70 f ssax:make-pi-p
ed60: 61 72 73 65 72 20 77 61 73 20 61 20 6c 6f 77 2d arser was a low-
ed70: 6c 65 76 65 6c 20 6d 61 63 72 6f 3a 0a 3b 20 28 level macro:.; (
ed80: 64 65 66 69 6e 65 2d 6d 61 63 72 6f 20 73 73 61 define-macro ssa
ed90: 78 3a 6d 61 6b 65 2d 70 69 2d 70 61 72 73 65 72 x:make-pi-parser
eda0: 0a 3b 20 20 20 28 6c 61 6d 62 64 61 20 28 6d 79 .; (lambda (my
edb0: 2d 70 69 2d 68 61 6e 64 6c 65 72 73 29 0a 3b 20 -pi-handlers).;
edc0: 20 20 60 28 6c 61 6d 62 64 61 20 28 70 6f 72 74 `(lambda (port
edd0: 20 74 61 72 67 65 74 20 73 65 65 64 29 0a 3b 20 target seed).;
ede0: 20 20 20 20 28 63 61 73 65 20 74 61 72 67 65 74 (case target
edf0: 0a 3b 20 09 3b 20 47 65 6e 65 72 61 74 65 20 74 .; .; Generate t
ee00: 68 65 20 62 6f 64 79 20 6f 66 20 74 68 65 20 63 he body of the c
ee10: 61 73 65 20 73 74 61 74 65 6d 65 6e 74 0a 3b 20 ase statement.;
ee20: 20 20 20 20 20 20 2c 40 28 6c 65 74 20 6c 6f 6f ,@(let loo
ee30: 70 20 28 28 70 69 2d 68 61 6e 64 6c 65 72 73 20 p ((pi-handlers
ee40: 6d 79 2d 70 69 2d 68 61 6e 64 6c 65 72 73 29 20 my-pi-handlers)
ee50: 28 64 65 66 61 75 6c 74 20 23 66 29 29 0a 3b 20 (default #f)).;
ee60: 09 20 28 63 6f 6e 64 0a 3b 20 09 20 20 28 28 6e . (cond.; . ((n
ee70: 75 6c 6c 3f 20 70 69 2d 68 61 6e 64 6c 65 72 73 ull? pi-handlers
ee80: 29 0a 3b 20 09 20 20 20 28 69 66 20 64 65 66 61 ).; . (if defa
ee90: 75 6c 74 20 60 28 28 65 6c 73 65 20 28 2c 64 65 ult `((else (,de
eea0: 66 61 75 6c 74 20 70 6f 72 74 20 74 61 72 67 65 fault port targe
eeb0: 74 20 73 65 65 64 29 29 29 0a 3b 20 09 20 20 20 t seed))).; .
eec0: 20 20 20 20 27 28 28 65 6c 73 65 0a 3b 20 09 09 '((else.; ..
eed0: 20 20 28 73 73 61 78 3a 77 61 72 6e 20 70 6f 72 (ssax:warn por
eee0: 74 20 22 53 6b 69 70 70 69 6e 67 20 50 49 3a 20 t "Skipping PI:
eef0: 22 20 74 61 72 67 65 74 20 6e 6c 29 0a 3b 20 09 " target nl).; .
ef00: 09 20 20 28 73 73 61 78 3a 73 6b 69 70 2d 70 69 . (ssax:skip-pi
ef10: 20 70 6f 72 74 29 0a 3b 20 09 09 20 20 73 65 65 port).; .. see
ef20: 64 29 29 29 29 0a 3b 20 09 20 20 28 28 65 71 3f d)))).; . ((eq?
ef30: 20 27 2a 44 45 46 41 55 4c 54 2a 20 28 63 61 61 '*DEFAULT* (caa
ef40: 72 20 70 69 2d 68 61 6e 64 6c 65 72 73 29 29 0a r pi-handlers)).
ef50: 3b 20 09 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 ; . (loop (cdr
ef60: 20 70 69 2d 68 61 6e 64 6c 65 72 73 29 20 28 63 pi-handlers) (c
ef70: 64 61 72 20 70 69 2d 68 61 6e 64 6c 65 72 73 29 dar pi-handlers)
ef80: 29 29 0a 3b 20 09 20 20 28 65 6c 73 65 0a 3b 20 )).; . (else.;
ef90: 09 20 20 20 28 63 6f 6e 73 0a 3b 20 09 20 20 20 . (cons.; .
efa0: 20 60 28 28 2c 28 63 61 61 72 20 70 69 2d 68 61 `((,(caar pi-ha
efb0: 6e 64 6c 65 72 73 29 29 20 28 2c 28 63 64 61 72 ndlers)) (,(cdar
efc0: 20 70 69 2d 68 61 6e 64 6c 65 72 73 29 20 70 6f pi-handlers) po
efd0: 72 74 20 74 61 72 67 65 74 20 73 65 65 64 29 29 rt target seed))
efe0: 0a 3b 20 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 .; . (loop (c
eff0: 64 72 20 70 69 2d 68 61 6e 64 6c 65 72 73 29 20 dr pi-handlers)
f000: 64 65 66 61 75 6c 74 29 29 29 29 29 29 29 29 29 default)))))))))
f010: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ..(define-syntax
f020: 20 73 73 61 78 3a 6d 61 6b 65 2d 70 69 2d 70 61 ssax:make-pi-pa
f030: 72 73 65 72 0a 20 20 28 73 79 6e 74 61 78 2d 72 rser. (syntax-r
f040: 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 73 73 ules (). ((ss
f050: 61 78 3a 6d 61 6b 65 2d 70 69 2d 70 61 72 73 65 ax:make-pi-parse
f060: 72 20 6f 72 69 67 2d 68 61 6e 64 6c 65 72 73 29 r orig-handlers)
f070: 0a 20 20 20 20 20 28 6c 65 74 72 65 63 2d 73 79 . (letrec-sy
f080: 6e 74 61 78 20 0a 09 3b 20 47 65 6e 65 72 61 74 ntax ..; Generat
f090: 65 20 74 68 65 20 63 6c 61 75 73 65 73 20 6f 66 e the clauses of
f0a0: 20 74 68 65 20 63 61 73 65 20 73 74 61 74 65 6d the case statem
f0b0: 65 6e 74 0a 20 20 20 20 20 20 28 28 6c 6f 6f 70 ent. ((loop
f0c0: 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 .. (syntax-rules
f0d0: 20 28 2a 44 45 46 41 55 4c 54 2a 29 0a 09 20 20 (*DEFAULT*)..
f0e0: 20 28 28 6c 6f 6f 70 20 28 29 20 23 66 20 61 63 ((loop () #f ac
f0f0: 63 75 6d 20 70 6f 72 74 20 74 61 72 67 65 74 20 cum port target
f100: 73 65 65 64 29 20 09 3b 20 6e 6f 20 64 65 66 61 seed) .; no defa
f110: 75 6c 74 0a 09 20 20 20 20 28 6d 61 6b 65 2d 63 ult.. (make-c
f120: 61 73 65 20 0a 09 20 20 20 20 20 20 28 28 65 6c ase .. ((el
f130: 73 65 0a 09 09 20 28 73 73 61 78 3a 77 61 72 6e se... (ssax:warn
f140: 20 70 6f 72 74 20 22 53 6b 69 70 70 69 6e 67 20 port "Skipping
f150: 50 49 3a 20 22 20 74 61 72 67 65 74 20 6e 6c 29 PI: " target nl)
f160: 0a 09 09 20 28 73 73 61 78 3a 73 6b 69 70 2d 70 ... (ssax:skip-p
f170: 69 20 70 6f 72 74 29 0a 09 09 20 73 65 65 64 29 i port)... seed)
f180: 0a 09 09 2e 20 61 63 63 75 6d 29 0a 09 20 20 20 .... accum)..
f190: 20 20 20 28 29 20 74 61 72 67 65 74 29 29 0a 09 () target))..
f1a0: 20 20 20 28 28 6c 6f 6f 70 20 28 29 20 64 65 66 ((loop () def
f1b0: 61 75 6c 74 20 61 63 63 75 6d 20 70 6f 72 74 20 ault accum port
f1c0: 74 61 72 67 65 74 20 73 65 65 64 29 0a 09 20 20 target seed)..
f1d0: 20 20 28 6d 61 6b 65 2d 63 61 73 65 20 0a 09 20 (make-case ..
f1e0: 20 20 20 20 20 28 28 65 6c 73 65 20 28 64 65 66 ((else (def
f1f0: 61 75 6c 74 20 70 6f 72 74 20 74 61 72 67 65 74 ault port target
f200: 20 73 65 65 64 29 29 20 2e 20 61 63 63 75 6d 29 seed)) . accum)
f210: 0a 09 20 20 20 20 20 20 28 29 20 74 61 72 67 65 .. () targe
f220: 74 29 29 0a 09 20 20 20 28 28 6c 6f 6f 70 20 28 t)).. ((loop (
f230: 28 2a 44 45 46 41 55 4c 54 2a 20 2e 20 64 65 66 (*DEFAULT* . def
f240: 61 75 6c 74 29 20 2e 20 68 61 6e 64 6c 65 72 73 ault) . handlers
f250: 29 20 6f 6c 64 2d 64 65 66 20 61 63 63 75 6d 0a ) old-def accum.
f260: 09 20 20 20 20 20 20 70 6f 72 74 20 74 61 72 67 . port targ
f270: 65 74 20 73 65 65 64 29 0a 09 20 20 20 20 28 6c et seed).. (l
f280: 6f 6f 70 20 68 61 6e 64 6c 65 72 73 20 64 65 66 oop handlers def
f290: 61 75 6c 74 20 61 63 63 75 6d 20 70 6f 72 74 20 ault accum port
f2a0: 74 61 72 67 65 74 20 73 65 65 64 29 29 0a 09 20 target seed))..
f2b0: 20 20 28 28 6c 6f 6f 70 20 28 28 74 61 67 20 2e ((loop ((tag .
f2c0: 20 68 61 6e 64 6c 65 72 29 20 2e 20 68 61 6e 64 handler) . hand
f2d0: 6c 65 72 73 29 20 64 65 66 61 75 6c 74 20 61 63 lers) default ac
f2e0: 63 75 6d 20 70 6f 72 74 20 74 61 72 67 65 74 20 cum port target
f2f0: 73 65 65 64 29 0a 09 20 20 20 20 28 6c 6f 6f 70 seed).. (loop
f300: 20 68 61 6e 64 6c 65 72 73 20 64 65 66 61 75 6c handlers defaul
f310: 74 0a 09 20 20 20 20 20 20 28 28 28 74 61 67 29 t.. (((tag)
f320: 20 28 68 61 6e 64 6c 65 72 20 70 6f 72 74 20 74 (handler port t
f330: 61 72 67 65 74 20 73 65 65 64 29 29 20 2e 20 61 arget seed)) . a
f340: 63 63 75 6d 29 0a 09 20 20 20 20 20 20 70 6f 72 ccum).. por
f350: 74 20 74 61 72 67 65 74 20 73 65 65 64 29 29 0a t target seed)).
f360: 09 20 20 20 29 29 0a 09 28 6d 61 6b 65 2d 63 61 . ))..(make-ca
f370: 73 65 20 09 09 09 3b 20 52 65 76 65 72 73 65 20 se ...; Reverse
f380: 74 68 65 20 63 6c 61 75 73 65 73 2c 20 6d 61 6b the clauses, mak
f390: 65 20 74 68 65 20 27 63 61 73 65 27 0a 09 20 20 e the 'case'..
f3a0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
f3b0: 0a 09 20 20 20 20 28 28 6d 61 6b 65 2d 63 61 73 .. ((make-cas
f3c0: 65 20 28 29 20 63 6c 61 75 73 65 73 20 74 61 72 e () clauses tar
f3d0: 67 65 74 29 0a 09 20 20 20 20 20 28 63 61 73 65 get).. (case
f3e0: 20 74 61 72 67 65 74 20 2e 20 63 6c 61 75 73 65 target . clause
f3f0: 73 29 29 0a 09 20 20 20 20 28 28 6d 61 6b 65 2d s)).. ((make-
f400: 63 61 73 65 20 28 63 6c 61 75 73 65 20 2e 20 63 case (clause . c
f410: 6c 61 75 73 65 73 29 20 61 63 63 75 6d 20 74 61 lauses) accum ta
f420: 72 67 65 74 29 0a 09 20 20 20 20 20 28 6d 61 6b rget).. (mak
f430: 65 2d 63 61 73 65 20 63 6c 61 75 73 65 73 20 28 e-case clauses (
f440: 63 6c 61 75 73 65 20 2e 20 61 63 63 75 6d 29 20 clause . accum)
f450: 74 61 72 67 65 74 29 29 29 0a 09 20 20 29 29 0a target))).. )).
f460: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 (lambda (p
f470: 6f 72 74 20 74 61 72 67 65 74 20 73 65 65 64 29 ort target seed)
f480: 0a 09 28 6c 6f 6f 70 20 6f 72 69 67 2d 68 61 6e ..(loop orig-han
f490: 64 6c 65 72 73 20 23 66 20 28 29 20 70 6f 72 74 dlers #f () port
f4a0: 20 74 61 72 67 65 74 20 73 65 65 64 29 29 0a 20 target seed)).
f4b0: 20 20 20 20 20 20 29 29 29 29 0a 0a 0a 3b 20 73 ))))...; s
f4c0: 79 6e 74 61 78 3a 20 73 73 61 78 3a 6d 61 6b 65 yntax: ssax:make
f4d0: 2d 65 6c 65 6d 2d 70 61 72 73 65 72 20 6d 79 2d -elem-parser my-
f4e0: 6e 65 77 2d 6c 65 76 65 6c 2d 73 65 65 64 20 6d new-level-seed m
f4f0: 79 2d 66 69 6e 69 73 68 2d 65 6c 65 6d 65 6e 74 y-finish-element
f500: 0a 3b 09 09 09 09 6d 79 2d 63 68 61 72 2d 64 61 .;....my-char-da
f510: 74 61 2d 68 61 6e 64 6c 65 72 20 6d 79 2d 70 69 ta-handler my-pi
f520: 2d 68 61 6e 64 6c 65 72 73 0a 0a 3b 20 43 72 65 -handlers..; Cre
f530: 61 74 65 20 61 20 70 61 72 73 65 72 20 74 6f 20 ate a parser to
f540: 70 61 72 73 65 20 61 6e 64 20 70 72 6f 63 65 73 parse and proces
f550: 73 20 6f 6e 65 20 65 6c 65 6d 65 6e 74 2c 20 69 s one element, i
f560: 6e 63 6c 75 64 69 6e 67 20 69 74 73 0a 3b 20 63 ncluding its.; c
f570: 68 61 72 61 63 74 65 72 20 63 6f 6e 74 65 6e 74 haracter content
f580: 20 6f 72 20 63 68 69 6c 64 72 65 6e 20 65 6c 65 or children ele
f590: 6d 65 6e 74 73 2e 20 54 68 65 20 70 61 72 73 65 ments. The parse
f5a0: 72 20 69 73 20 74 79 70 69 63 61 6c 6c 79 0a 3b r is typically.;
f5b0: 20 61 70 70 6c 69 65 64 20 74 6f 20 74 68 65 20 applied to the
f5c0: 72 6f 6f 74 20 65 6c 65 6d 65 6e 74 20 6f 66 20 root element of
f5d0: 61 20 64 6f 63 75 6d 65 6e 74 2e 0a 0a 3b 20 6d a document...; m
f5e0: 79 2d 6e 65 77 2d 6c 65 76 65 6c 2d 73 65 65 64 y-new-level-seed
f5f0: 0a 3b 09 70 72 6f 63 65 64 75 72 65 20 45 4c 45 .;.procedure ELE
f600: 4d 2d 47 49 20 41 54 54 52 49 42 55 54 45 53 20 M-GI ATTRIBUTES
f610: 4e 41 4d 45 53 50 41 43 45 53 20 45 58 50 45 43 NAMESPACES EXPEC
f620: 54 45 44 2d 43 4f 4e 54 45 4e 54 20 53 45 45 44 TED-CONTENT SEED
f630: 0a 3b 09 09 77 68 65 72 65 20 45 4c 45 4d 2d 47 .;..where ELEM-G
f640: 49 20 69 73 20 61 20 52 45 53 2d 4e 41 4d 45 20 I is a RES-NAME
f650: 6f 66 20 74 68 65 20 65 6c 65 6d 65 6e 74 0a 3b of the element.;
f660: 09 09 61 62 6f 75 74 20 74 6f 20 62 65 20 70 72 ..about to be pr
f670: 6f 63 65 73 73 65 64 2e 0a 3b 09 54 68 69 73 20 ocessed..;.This
f680: 70 72 6f 63 65 64 75 72 65 20 69 73 20 74 6f 20 procedure is to
f690: 67 65 6e 65 72 61 74 65 20 74 68 65 20 73 65 65 generate the see
f6a0: 64 20 74 6f 20 62 65 20 70 61 73 73 65 64 0a 3b d to be passed.;
f6b0: 09 74 6f 20 68 61 6e 64 6c 65 72 73 20 74 68 61 .to handlers tha
f6c0: 74 20 70 72 6f 63 65 73 73 20 74 68 65 20 63 6f t process the co
f6d0: 6e 74 65 6e 74 20 6f 66 20 74 68 65 20 65 6c 65 ntent of the ele
f6e0: 6d 65 6e 74 2e 0a 3b 09 54 68 69 73 20 69 73 20 ment..;.This is
f6f0: 74 68 65 20 66 75 6e 63 74 69 6f 6e 20 69 64 65 the function ide
f700: 6e 74 69 66 69 65 64 20 61 73 20 27 66 64 6f 77 ntified as 'fdow
f710: 6e 27 20 69 6e 20 74 68 65 20 64 65 6e 6f 74 61 n' in the denota
f720: 74 69 6f 6e 61 6c 0a 3b 09 73 65 6d 61 6e 74 69 tional.;.semanti
f730: 63 73 20 6f 66 20 74 68 65 20 58 4d 4c 20 70 61 cs of the XML pa
f740: 72 73 65 72 20 67 69 76 65 6e 20 69 6e 20 74 68 rser given in th
f750: 65 20 74 69 74 6c 65 20 63 6f 6d 6d 65 6e 74 73 e title comments
f760: 20 74 6f 20 74 68 69 73 0a 3b 09 66 69 6c 65 2e to this.;.file.
f770: 0a 3b 0a 3b 20 6d 79 2d 66 69 6e 69 73 68 2d 65 .;.; my-finish-e
f780: 6c 65 6d 65 6e 74 0a 3b 09 70 72 6f 63 65 64 75 lement.;.procedu
f790: 72 65 20 45 4c 45 4d 2d 47 49 20 41 54 54 52 49 re ELEM-GI ATTRI
f7a0: 42 55 54 45 53 20 4e 41 4d 45 53 50 41 43 45 53 BUTES NAMESPACES
f7b0: 20 50 41 52 45 4e 54 2d 53 45 45 44 20 53 45 45 PARENT-SEED SEE
f7c0: 44 0a 3b 09 54 68 69 73 20 70 72 6f 63 65 64 75 D.;.This procedu
f7d0: 72 65 20 69 73 20 63 61 6c 6c 65 64 20 77 68 65 re is called whe
f7e0: 6e 20 70 61 72 73 69 6e 67 20 6f 66 20 45 4c 45 n parsing of ELE
f7f0: 4d 2d 47 49 20 69 73 20 66 69 6e 69 73 68 65 64 M-GI is finished
f800: 2e 0a 3b 09 54 68 65 20 53 45 45 44 20 69 73 20 ..;.The SEED is
f810: 74 68 65 20 72 65 73 75 6c 74 20 66 72 6f 6d 20 the result from
f820: 74 68 65 20 6c 61 73 74 20 63 6f 6e 74 65 6e 74 the last content
f830: 20 70 61 72 73 65 72 20 28 6f 72 0a 3b 09 66 72 parser (or.;.fr
f840: 6f 6d 20 6d 79 2d 6e 65 77 2d 6c 65 76 65 6c 2d om my-new-level-
f850: 73 65 65 64 20 69 66 20 74 68 65 20 65 6c 65 6d seed if the elem
f860: 65 6e 74 20 68 61 73 20 74 68 65 20 65 6d 70 74 ent has the empt
f870: 79 20 63 6f 6e 74 65 6e 74 29 2e 0a 3b 09 50 41 y content)..;.PA
f880: 52 45 4e 54 2d 53 45 45 44 20 69 73 20 74 68 65 RENT-SEED is the
f890: 20 73 61 6d 65 20 73 65 65 64 20 61 73 20 77 61 same seed as wa
f8a0: 73 20 70 61 73 73 65 64 20 74 6f 20 6d 79 2d 6e s passed to my-n
f8b0: 65 77 2d 6c 65 76 65 6c 2d 73 65 65 64 2e 0a 3b ew-level-seed..;
f8c0: 09 54 68 65 20 70 72 6f 63 65 64 75 72 65 20 69 .The procedure i
f8d0: 73 20 74 6f 20 67 65 6e 65 72 61 74 65 20 61 20 s to generate a
f8e0: 73 65 65 64 20 74 68 61 74 20 77 69 6c 6c 20 62 seed that will b
f8f0: 65 20 74 68 65 20 72 65 73 75 6c 74 0a 3b 09 6f e the result.;.o
f900: 66 20 74 68 65 20 65 6c 65 6d 65 6e 74 20 70 61 f the element pa
f910: 72 73 65 72 2e 0a 3b 09 54 68 69 73 20 69 73 20 rser..;.This is
f920: 74 68 65 20 66 75 6e 63 74 69 6f 6e 20 69 64 65 the function ide
f930: 6e 74 69 66 69 65 64 20 61 73 20 27 66 75 70 27 ntified as 'fup'
f940: 20 69 6e 20 74 68 65 20 64 65 6e 6f 74 61 74 69 in the denotati
f950: 6f 6e 61 6c 0a 3b 09 73 65 6d 61 6e 74 69 63 73 onal.;.semantics
f960: 20 6f 66 20 74 68 65 20 58 4d 4c 20 70 61 72 73 of the XML pars
f970: 65 72 20 67 69 76 65 6e 20 69 6e 20 74 68 65 20 er given in the
f980: 74 69 74 6c 65 20 63 6f 6d 6d 65 6e 74 73 20 74 title comments t
f990: 6f 20 74 68 69 73 0a 3b 09 66 69 6c 65 2e 0a 3b o this.;.file..;
f9a0: 0a 3b 20 6d 79 2d 63 68 61 72 2d 64 61 74 61 2d .; my-char-data-
f9b0: 68 61 6e 64 6c 65 72 0a 3b 09 41 20 53 54 52 2d handler.;.A STR-
f9c0: 48 41 4e 44 4c 45 52 0a 3b 0a 3b 20 6d 79 2d 70 HANDLER.;.; my-p
f9d0: 69 2d 68 61 6e 64 6c 65 72 73 0a 3b 09 53 65 65 i-handlers.;.See
f9e0: 20 73 73 61 78 3a 6d 61 6b 65 2d 70 69 2d 68 61 ssax:make-pi-ha
f9f0: 6e 64 6c 65 72 20 61 62 6f 76 65 0a 3b 0a 0a 3b ndler above.;..;
fa00: 20 54 68 65 20 67 65 6e 65 72 61 74 65 64 20 70 The generated p
fa10: 61 72 73 65 72 20 69 73 20 61 0a 3b 09 70 72 6f arser is a.;.pro
fa20: 63 65 64 75 72 65 20 53 54 41 52 54 2d 54 41 47 cedure START-TAG
fa30: 2d 48 45 41 44 20 50 4f 52 54 20 45 4c 45 4d 53 -HEAD PORT ELEMS
fa40: 20 45 4e 54 49 54 49 45 53 0a 3b 09 4e 41 4d 45 ENTITIES.;.NAME
fa50: 53 50 41 43 45 53 20 50 52 45 53 45 52 56 45 2d SPACES PRESERVE-
fa60: 57 53 3f 20 53 45 45 44 0a 3b 20 54 68 65 20 70 WS? SEED.; The p
fa70: 72 6f 63 65 64 75 72 65 20 6d 75 73 74 20 62 65 rocedure must be
fa80: 20 63 61 6c 6c 65 64 20 61 66 74 65 72 20 74 68 called after th
fa90: 65 20 73 74 61 72 74 20 74 61 67 20 74 6f 6b 65 e start tag toke
faa0: 6e 20 68 61 73 20 62 65 65 6e 0a 3b 20 72 65 61 n has been.; rea
fab0: 64 2e 20 53 54 41 52 54 2d 54 41 47 2d 48 45 41 d. START-TAG-HEA
fac0: 44 20 69 73 20 61 6e 20 55 4e 52 45 53 2d 4e 41 D is an UNRES-NA
fad0: 4d 45 20 66 72 6f 6d 20 74 68 65 20 73 74 61 72 ME from the star
fae0: 74 2d 65 6c 65 6d 65 6e 74 20 74 61 67 2e 0a 3b t-element tag..;
faf0: 20 45 4c 45 4d 53 20 69 73 20 61 6e 20 69 6e 73 ELEMS is an ins
fb00: 74 61 6e 63 65 20 6f 66 20 78 6d 6c 2d 64 65 63 tance of xml-dec
fb10: 6c 3a 3a 65 6c 65 6d 73 2e 0a 3b 20 53 65 65 20 l::elems..; See
fb20: 73 73 61 78 3a 63 6f 6d 70 6c 65 74 65 2d 73 74 ssax:complete-st
fb30: 61 72 74 2d 74 61 67 3a 3a 70 72 65 73 65 72 76 art-tag::preserv
fb40: 65 2d 77 73 3f 0a 0a 3b 20 46 61 75 6c 74 73 20 e-ws?..; Faults
fb50: 64 65 74 65 63 74 65 64 3a 0a 3b 09 56 43 3a 20 detected:.;.VC:
fb60: 58 4d 4c 2d 53 70 65 63 2e 68 74 6d 6c 23 65 6c XML-Spec.html#el
fb70: 65 6d 65 6e 74 76 61 6c 69 64 20 0a 3b 09 57 46 ementvalid .;.WF
fb80: 43 3a 20 58 4d 4c 2d 53 70 65 63 2e 68 74 6d 6c C: XML-Spec.html
fb90: 23 47 49 4d 61 74 63 68 0a 0a 0a 28 64 65 66 69 #GIMatch...(defi
fba0: 6e 65 2d 73 79 6e 74 61 78 20 73 73 61 78 3a 6d ne-syntax ssax:m
fbb0: 61 6b 65 2d 65 6c 65 6d 2d 70 61 72 73 65 72 0a ake-elem-parser.
fbc0: 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 (syntax-rules
fbd0: 28 29 0a 20 20 20 20 28 28 73 73 61 78 3a 6d 61 (). ((ssax:ma
fbe0: 6b 65 2d 65 6c 65 6d 2d 70 61 72 73 65 72 20 6d ke-elem-parser m
fbf0: 79 2d 6e 65 77 2d 6c 65 76 65 6c 2d 73 65 65 64 y-new-level-seed
fc00: 20 6d 79 2d 66 69 6e 69 73 68 2d 65 6c 65 6d 65 my-finish-eleme
fc10: 6e 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nt.
fc20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d m
fc30: 79 2d 63 68 61 72 2d 64 61 74 61 2d 68 61 6e 64 y-char-data-hand
fc40: 6c 65 72 20 6d 79 2d 70 69 2d 68 61 6e 64 6c 65 ler my-pi-handle
fc50: 72 73 29 0a 20 20 0a 20 20 20 28 6c 61 6d 62 64 rs). . (lambd
fc60: 61 20 28 73 74 61 72 74 2d 74 61 67 2d 68 65 61 a (start-tag-hea
fc70: 64 20 70 6f 72 74 20 65 6c 65 6d 73 20 65 6e 74 d port elems ent
fc80: 69 74 69 65 73 20 6e 61 6d 65 73 70 61 63 65 73 ities namespaces
fc90: 0a 09 09 09 20 20 20 70 72 65 73 65 72 76 65 2d .... preserve-
fca0: 77 73 3f 20 73 65 65 64 29 0a 0a 20 20 20 20 20 ws? seed)..
fcb0: 28 64 65 66 69 6e 65 20 78 6d 6c 2d 73 70 61 63 (define xml-spac
fcc0: 65 2d 67 69 20 28 63 6f 6e 73 20 73 73 61 78 3a e-gi (cons ssax:
fcd0: 50 72 65 66 69 78 2d 58 4d 4c 0a 09 09 09 09 28 Prefix-XML.....(
fce0: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 string->symbol "
fcf0: 73 70 61 63 65 22 29 29 29 0a 0a 20 20 20 20 20 space")))..
fd00: 28 6c 65 74 20 68 61 6e 64 6c 65 2d 73 74 61 72 (let handle-star
fd10: 74 2d 74 61 67 20 28 28 73 74 61 72 74 2d 74 61 t-tag ((start-ta
fd20: 67 2d 68 65 61 64 20 73 74 61 72 74 2d 74 61 67 g-head start-tag
fd30: 2d 68 65 61 64 29 0a 09 09 09 20 20 20 20 28 70 -head).... (p
fd40: 6f 72 74 20 70 6f 72 74 29 20 28 65 6e 74 69 74 ort port) (entit
fd50: 69 65 73 20 65 6e 74 69 74 69 65 73 29 0a 09 09 ies entities)...
fd60: 09 20 20 20 20 28 6e 61 6d 65 73 70 61 63 65 73 . (namespaces
fd70: 20 6e 61 6d 65 73 70 61 63 65 73 29 0a 09 09 09 namespaces)....
fd80: 20 20 20 20 28 70 72 65 73 65 72 76 65 2d 77 73 (preserve-ws
fd90: 3f 20 70 72 65 73 65 72 76 65 2d 77 73 3f 29 20 ? preserve-ws?)
fda0: 28 70 61 72 65 6e 74 2d 73 65 65 64 20 73 65 65 (parent-seed see
fdb0: 64 29 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a d)). (let*
fdc0: 2d 76 61 6c 75 65 73 0a 09 28 28 28 65 6c 65 6d -values..(((elem
fdd0: 2d 67 69 20 61 74 74 72 69 62 75 74 65 73 20 6e -gi attributes n
fde0: 61 6d 65 73 70 61 63 65 73 20 65 78 70 65 63 74 amespaces expect
fdf0: 65 64 2d 63 6f 6e 74 65 6e 74 29 0a 09 20 20 28 ed-content).. (
fe00: 73 73 61 78 3a 63 6f 6d 70 6c 65 74 65 2d 73 74 ssax:complete-st
fe10: 61 72 74 2d 74 61 67 20 73 74 61 72 74 2d 74 61 art-tag start-ta
fe20: 67 2d 68 65 61 64 20 70 6f 72 74 20 65 6c 65 6d g-head port elem
fe30: 73 0a 09 09 09 09 20 20 20 65 6e 74 69 74 69 65 s..... entitie
fe40: 73 20 6e 61 6d 65 73 70 61 63 65 73 29 29 0a 09 s namespaces))..
fe50: 20 28 28 73 65 65 64 29 0a 09 20 20 28 6d 79 2d ((seed).. (my-
fe60: 6e 65 77 2d 6c 65 76 65 6c 2d 73 65 65 64 20 65 new-level-seed e
fe70: 6c 65 6d 2d 67 69 20 61 74 74 72 69 62 75 74 65 lem-gi attribute
fe80: 73 0a 09 09 09 20 20 20 20 20 20 6e 61 6d 65 73 s.... names
fe90: 70 61 63 65 73 20 65 78 70 65 63 74 65 64 2d 63 paces expected-c
fea0: 6f 6e 74 65 6e 74 20 70 61 72 65 6e 74 2d 73 65 ontent parent-se
feb0: 65 64 29 29 29 0a 09 28 63 61 73 65 20 65 78 70 ed)))..(case exp
fec0: 65 63 74 65 64 2d 63 6f 6e 74 65 6e 74 0a 09 20 ected-content..
fed0: 20 28 28 45 4d 50 54 59 2d 54 41 47 29 0a 09 20 ((EMPTY-TAG)..
fee0: 20 20 28 6d 79 2d 66 69 6e 69 73 68 2d 65 6c 65 (my-finish-ele
fef0: 6d 65 6e 74 0a 09 20 20 20 20 65 6c 65 6d 2d 67 ment.. elem-g
ff00: 69 20 61 74 74 72 69 62 75 74 65 73 20 6e 61 6d i attributes nam
ff10: 65 73 70 61 63 65 73 20 70 61 72 65 6e 74 2d 73 espaces parent-s
ff20: 65 65 64 20 73 65 65 64 29 29 0a 09 20 20 28 28 eed seed)).. ((
ff30: 45 4d 50 54 59 29 09 09 3b 20 54 68 65 20 65 6e EMPTY)..; The en
ff40: 64 20 74 61 67 20 6d 75 73 74 20 69 6d 6d 65 64 d tag must immed
ff50: 69 61 74 65 6c 79 20 66 6f 6c 6c 6f 77 0a 09 20 iately follow..
ff60: 20 20 28 73 73 61 78 3a 61 73 73 65 72 74 2d 74 (ssax:assert-t
ff70: 6f 6b 65 6e 20 0a 09 20 20 20 20 28 61 6e 64 20 oken .. (and
ff80: 28 65 71 76 3f 20 23 5c 3c 20 28 73 73 61 78 3a (eqv? #\< (ssax:
ff90: 73 6b 69 70 2d 53 20 70 6f 72 74 29 29 20 28 73 skip-S port)) (s
ffa0: 73 61 78 3a 72 65 61 64 2d 6d 61 72 6b 75 70 2d sax:read-markup-
ffb0: 74 6f 6b 65 6e 20 70 6f 72 74 29 29 0a 09 20 20 token port))..
ffc0: 20 20 27 45 4e 44 20 20 73 74 61 72 74 2d 74 61 'END start-ta
ffd0: 67 2d 68 65 61 64 0a 09 20 20 20 20 28 6c 61 6d g-head.. (lam
ffe0: 62 64 61 20 28 74 6f 6b 65 6e 20 65 78 70 2d 6b bda (token exp-k
fff0: 69 6e 64 20 65 78 70 2d 68 65 61 64 29 0a 09 20 ind exp-head)..
10000 20 20 20 20 20 28 70 61 72 73 65 72 2d 65 72 72 (parser-err
10010 6f 72 20 70 6f 72 74 20 22 5b 65 6c 65 6d 65 6e or port "[elemen
10020 74 76 61 6c 69 64 5d 20 62 72 6f 6b 65 6e 20 66 tvalid] broken f
10030 6f 72 20 22 20 74 6f 6b 65 6e 20 0a 09 09 20 20 or " token ...
10040 20 20 20 22 20 77 68 69 6c 65 20 65 78 70 65 63 " while expec
10050 74 69 6e 67 20 22 0a 09 09 20 20 20 20 20 65 78 ting "... ex
10060 70 2d 6b 69 6e 64 20 65 78 70 2d 68 65 61 64 29 p-kind exp-head)
10070 29 29 0a 09 20 20 20 28 6d 79 2d 66 69 6e 69 73 )).. (my-finis
10080 68 2d 65 6c 65 6d 65 6e 74 0a 09 20 20 20 20 65 h-element.. e
10090 6c 65 6d 2d 67 69 20 61 74 74 72 69 62 75 74 65 lem-gi attribute
100a0 73 20 6e 61 6d 65 73 70 61 63 65 73 20 70 61 72 s namespaces par
100b0 65 6e 74 2d 73 65 65 64 20 73 65 65 64 29 29 0a ent-seed seed)).
100c0 09 20 20 28 65 6c 73 65 09 09 3b 20 72 65 61 64 . (else..; read
100d0 69 6e 67 20 74 68 65 20 63 6f 6e 74 65 6e 74 2e ing the content.
100e0 2e 2e 0a 09 20 20 20 28 6c 65 74 20 28 28 70 72 .... (let ((pr
100f0 65 73 65 72 76 65 2d 77 73 3f 20 20 3b 20 69 6e eserve-ws? ; in
10100 68 65 72 69 74 20 6f 72 20 73 65 74 20 74 68 65 herit or set the
10110 20 70 72 65 73 65 72 76 65 2d 77 73 3f 20 66 6c preserve-ws? fl
10120 61 67 0a 09 09 20 20 28 63 6f 6e 64 0a 09 09 20 ag... (cond...
10130 20 20 28 28 61 73 73 6f 63 20 78 6d 6c 2d 73 70 ((assoc xml-sp
10140 61 63 65 2d 67 69 20 61 74 74 72 69 62 75 74 65 ace-gi attribute
10150 73 29 20 3d 3e 0a 09 09 20 20 20 20 28 6c 61 6d s) =>... (lam
10160 62 64 61 20 28 6e 61 6d 65 2d 76 61 6c 75 65 29 bda (name-value)
10170 0a 09 09 20 20 20 20 20 20 28 65 71 75 61 6c 3f ... (equal?
10180 20 22 70 72 65 73 65 72 76 65 22 20 28 63 64 72 "preserve" (cdr
10190 20 6e 61 6d 65 2d 76 61 6c 75 65 29 29 29 29 0a name-value)))).
101a0 09 09 20 20 20 28 65 6c 73 65 20 70 72 65 73 65 .. (else prese
101b0 72 76 65 2d 77 73 3f 29 29 29 29 0a 09 20 20 20 rve-ws?))))..
101c0 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 70 6f (let loop ((po
101d0 72 74 20 70 6f 72 74 29 20 28 65 6e 74 69 74 69 rt port) (entiti
101e0 65 73 20 65 6e 74 69 74 69 65 73 29 0a 09 09 09 es entities)....
101f0 28 65 78 70 65 63 74 2d 65 6f 66 3f 20 23 66 29 (expect-eof? #f)
10200 20 28 73 65 65 64 20 73 65 65 64 29 29 0a 09 20 (seed seed))..
10210 20 20 20 20 20 20 28 6c 65 74 2a 2d 76 61 6c 75 (let*-valu
10220 65 73 0a 09 09 28 28 28 73 65 65 64 20 74 65 72 es...(((seed ter
10230 6d 2d 74 6f 6b 65 6e 29 0a 09 09 20 20 28 73 73 m-token)... (ss
10240 61 78 3a 72 65 61 64 2d 63 68 61 72 2d 64 61 74 ax:read-char-dat
10250 61 20 70 6f 72 74 20 65 78 70 65 63 74 2d 65 6f a port expect-eo
10260 66 3f 0a 09 09 09 09 20 20 20 20 20 20 20 6d 79 f?..... my
10270 2d 63 68 61 72 2d 64 61 74 61 2d 68 61 6e 64 6c -char-data-handl
10280 65 72 20 73 65 65 64 29 29 29 0a 09 09 28 69 66 er seed)))...(if
10290 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 74 65 (eof-object? te
102a0 72 6d 2d 74 6f 6b 65 6e 29 0a 09 09 20 20 20 20 rm-token)...
102b0 73 65 65 64 0a 09 09 20 20 20 20 28 63 61 73 65 seed... (case
102c0 20 28 78 6d 6c 2d 74 6f 6b 65 6e 2d 6b 69 6e 64 (xml-token-kind
102d0 20 74 65 72 6d 2d 74 6f 6b 65 6e 29 0a 09 09 20 term-token)...
102e0 20 20 20 20 20 28 28 45 4e 44 29 0a 09 09 20 20 ((END)...
102f0 20 20 20 20 20 28 73 73 61 78 3a 61 73 73 65 72 (ssax:asser
10300 74 2d 74 6f 6b 65 6e 20 74 65 72 6d 2d 74 6f 6b t-token term-tok
10310 65 6e 20 27 45 4e 44 20 20 73 74 61 72 74 2d 74 en 'END start-t
10320 61 67 2d 68 65 61 64 0a 09 09 09 20 20 28 6c 61 ag-head.... (la
10330 6d 62 64 61 20 28 74 6f 6b 65 6e 20 65 78 70 2d mbda (token exp-
10340 6b 69 6e 64 20 65 78 70 2d 68 65 61 64 29 0a 09 kind exp-head)..
10350 09 09 20 20 20 20 28 70 61 72 73 65 72 2d 65 72 .. (parser-er
10360 72 6f 72 20 70 6f 72 74 20 22 5b 47 49 4d 61 74 ror port "[GIMat
10370 63 68 5d 20 62 72 6f 6b 65 6e 20 66 6f 72 20 22 ch] broken for "
10380 0a 09 09 09 09 20 20 20 74 65 72 6d 2d 74 6f 6b ..... term-tok
10390 65 6e 20 22 20 77 68 69 6c 65 20 65 78 70 65 63 en " while expec
103a0 74 69 6e 67 20 22 0a 09 09 09 09 20 20 20 65 78 ting "..... ex
103b0 70 2d 6b 69 6e 64 20 65 78 70 2d 68 65 61 64 29 p-kind exp-head)
103c0 29 29 0a 09 09 20 20 20 20 20 20 20 28 6d 79 2d ))... (my-
103d0 66 69 6e 69 73 68 2d 65 6c 65 6d 65 6e 74 0a 09 finish-element..
103e0 09 09 65 6c 65 6d 2d 67 69 20 61 74 74 72 69 62 ..elem-gi attrib
103f0 75 74 65 73 20 6e 61 6d 65 73 70 61 63 65 73 20 utes namespaces
10400 70 61 72 65 6e 74 2d 73 65 65 64 20 73 65 65 64 parent-seed seed
10410 29 29 0a 09 09 20 20 20 20 20 20 28 28 50 49 29 ))... ((PI)
10420 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 ... (let (
10430 28 73 65 65 64 20 0a 09 09 09 20 20 28 28 73 73 (seed .... ((ss
10440 61 78 3a 6d 61 6b 65 2d 70 69 2d 70 61 72 73 65 ax:make-pi-parse
10450 72 20 6d 79 2d 70 69 2d 68 61 6e 64 6c 65 72 73 r my-pi-handlers
10460 29 0a 09 09 09 20 20 20 70 6f 72 74 20 28 78 6d ).... port (xm
10470 6c 2d 74 6f 6b 65 6e 2d 68 65 61 64 20 74 65 72 l-token-head ter
10480 6d 2d 74 6f 6b 65 6e 29 20 73 65 65 64 29 29 29 m-token) seed)))
10490 0a 09 09 09 20 28 6c 6f 6f 70 20 70 6f 72 74 20 .... (loop port
104a0 65 6e 74 69 74 69 65 73 20 65 78 70 65 63 74 2d entities expect-
104b0 65 6f 66 3f 20 73 65 65 64 29 29 29 0a 09 09 20 eof? seed)))...
104c0 20 20 20 20 20 28 28 45 4e 54 49 54 59 2d 52 45 ((ENTITY-RE
104d0 46 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 F)... (let
104e0 20 28 28 73 65 65 64 0a 09 09 09 20 20 20 20 20 ((seed....
104f0 20 28 73 73 61 78 3a 68 61 6e 64 6c 65 2d 70 61 (ssax:handle-pa
10500 72 73 65 64 2d 65 6e 74 69 74 79 0a 09 09 09 20 rsed-entity....
10510 20 20 20 20 20 20 70 6f 72 74 20 28 78 6d 6c 2d port (xml-
10520 74 6f 6b 65 6e 2d 68 65 61 64 20 74 65 72 6d 2d token-head term-
10530 74 6f 6b 65 6e 29 0a 09 09 09 20 20 20 20 20 20 token)....
10540 20 65 6e 74 69 74 69 65 73 0a 09 09 09 20 20 20 entities....
10550 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 6f 72 (lambda (por
10560 74 20 65 6e 74 69 74 69 65 73 20 73 65 65 64 29 t entities seed)
10570 0a 09 09 09 09 20 28 6c 6f 6f 70 20 70 6f 72 74 ..... (loop port
10580 20 65 6e 74 69 74 69 65 73 20 23 74 20 73 65 65 entities #t see
10590 64 29 29 0a 09 09 09 20 20 20 20 20 20 20 6d 79 d)).... my
105a0 2d 63 68 61 72 2d 64 61 74 61 2d 68 61 6e 64 6c -char-data-handl
105b0 65 72 0a 09 09 09 20 20 20 20 20 20 20 73 65 65 er.... see
105c0 64 29 29 29 20 3b 20 6b 65 65 70 20 6f 6e 20 72 d))) ; keep on r
105d0 65 61 64 69 6e 67 20 74 68 65 20 63 6f 6e 74 65 eading the conte
105e0 6e 74 20 61 66 74 65 72 20 65 6e 74 0a 09 09 09 nt after ent....
105f0 20 28 6c 6f 6f 70 20 70 6f 72 74 20 65 6e 74 69 (loop port enti
10600 74 69 65 73 20 65 78 70 65 63 74 2d 65 6f 66 3f ties expect-eof?
10610 20 73 65 65 64 29 29 29 0a 09 09 20 20 20 20 20 seed)))...
10620 20 28 28 53 54 41 52 54 29 09 09 3b 20 53 74 61 ((START)..; Sta
10630 72 74 20 6f 66 20 61 20 63 68 69 6c 64 20 65 6c rt of a child el
10640 65 6d 65 6e 74 0a 09 09 20 20 20 20 20 20 20 28 ement... (
10650 69 66 20 28 65 71 3f 20 65 78 70 65 63 74 65 64 if (eq? expected
10660 2d 63 6f 6e 74 65 6e 74 20 27 50 43 44 41 54 41 -content 'PCDATA
10670 29 0a 09 09 09 20 20 20 28 70 61 72 73 65 72 2d ).... (parser-
10680 65 72 72 6f 72 20 70 6f 72 74 20 22 5b 65 6c 65 error port "[ele
10690 6d 65 6e 74 76 61 6c 69 64 5d 20 62 72 6f 6b 65 mentvalid] broke
106a0 6e 20 66 6f 72 20 22 0a 09 09 09 09 20 20 65 6c n for "..... el
106b0 65 6d 2d 67 69 0a 09 09 09 09 20 20 22 20 77 69 em-gi..... " wi
106c0 74 68 20 63 68 61 72 20 63 6f 6e 74 65 6e 74 20 th char content
106d0 6f 6e 6c 79 3b 20 75 6e 65 78 70 65 63 74 65 64 only; unexpected
106e0 20 74 6f 6b 65 6e 20 22 0a 09 09 09 09 20 20 74 token "..... t
106f0 65 72 6d 2d 74 6f 6b 65 6e 29 29 0a 09 09 09 20 erm-token))....
10700 20 20 3b 20 44 6f 20 6f 74 68 65 72 20 76 61 6c ; Do other val
10710 69 64 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 65 idation of the e
10720 6c 65 6d 65 6e 74 20 63 6f 6e 74 65 6e 74 0a 09 lement content..
10730 09 09 20 20 20 28 6c 65 74 20 28 28 73 65 65 64 .. (let ((seed
10740 0a 09 09 09 09 20 20 28 68 61 6e 64 6c 65 2d 73 ..... (handle-s
10750 74 61 72 74 2d 74 61 67 0a 09 09 09 09 20 20 20 tart-tag.....
10760 20 20 28 78 6d 6c 2d 74 6f 6b 65 6e 2d 68 65 61 (xml-token-hea
10770 64 20 74 65 72 6d 2d 74 6f 6b 65 6e 29 0a 09 09 d term-token)...
10780 09 09 20 20 20 20 20 70 6f 72 74 20 65 6e 74 69 .. port enti
10790 74 69 65 73 20 6e 61 6d 65 73 70 61 63 65 73 0a ties namespaces.
107a0 09 09 09 09 20 20 20 20 20 70 72 65 73 65 72 76 .... preserv
107b0 65 2d 77 73 3f 20 73 65 65 64 29 29 29 0a 09 09 e-ws? seed)))...
107c0 09 20 20 20 20 20 28 6c 6f 6f 70 20 70 6f 72 74 . (loop port
107d0 20 65 6e 74 69 74 69 65 73 20 65 78 70 65 63 74 entities expect
107e0 2d 65 6f 66 3f 20 73 65 65 64 29 29 29 0a 09 09 -eof? seed)))...
107f0 20 20 20 20 20 20 28 65 6c 73 65 0a 09 09 20 20 (else...
10800 20 20 20 20 20 28 70 61 72 73 65 72 2d 65 72 72 (parser-err
10810 6f 72 20 70 6f 72 74 20 22 58 4d 4c 20 5b 34 33 or port "XML [43
10820 5d 20 62 72 6f 6b 65 6e 20 66 6f 72 20 22 0a 09 ] broken for "..
10830 09 09 09 20 20 20 20 20 74 65 72 6d 2d 74 6f 6b ... term-tok
10840 65 6e 29 29 29 29 29 29 29 29 0a 09 20 20 29 29 en)))))))).. ))
10850 29 0a 29 29 29 29 0a 0a 0a 3b 20 73 79 6e 74 61 ).))))...; synta
10860 78 3a 20 73 73 61 78 3a 6d 61 6b 65 2d 70 61 72 x: ssax:make-par
10870 73 65 72 20 75 73 65 72 2d 68 61 6e 64 6c 65 72 ser user-handler
10880 2d 74 61 67 20 75 73 65 72 2d 68 61 6e 64 6c 65 -tag user-handle
10890 72 2d 70 72 6f 63 20 2e 2e 2e 0a 3b 0a 3b 20 43 r-proc ....;.; C
108a0 72 65 61 74 65 20 61 6e 20 58 4d 4c 20 70 61 72 reate an XML par
108b0 73 65 72 2c 20 61 6e 20 69 6e 73 74 61 6e 63 65 ser, an instance
108c0 20 6f 66 20 74 68 65 20 58 4d 4c 20 70 61 72 73 of the XML pars
108d0 69 6e 67 20 66 72 61 6d 65 77 6f 72 6b 2e 0a 3b ing framework..;
108e0 20 54 68 69 73 20 77 69 6c 6c 20 62 65 20 61 20 This will be a
108f0 53 41 58 2c 20 61 20 44 4f 4d 2c 20 6f 72 20 61 SAX, a DOM, or a
10900 20 73 70 65 63 69 61 6c 69 7a 65 64 20 70 61 72 specialized par
10910 73 65 72 20 64 65 70 65 6e 64 69 6e 67 0a 3b 20 ser depending.;
10920 6f 6e 20 74 68 65 20 73 75 70 70 6c 69 65 64 20 on the supplied
10930 75 73 65 72 2d 68 61 6e 64 6c 65 72 73 2e 0a 0a user-handlers...
10940 3b 20 75 73 65 72 2d 68 61 6e 64 6c 65 72 2d 74 ; user-handler-t
10950 61 67 20 69 73 20 61 20 73 79 6d 62 6f 6c 20 74 ag is a symbol t
10960 68 61 74 20 69 64 65 6e 74 69 66 69 65 73 20 61 hat identifies a
10970 20 70 72 6f 63 65 64 75 72 61 6c 20 65 78 70 72 procedural expr
10980 65 73 73 69 6f 6e 0a 3b 20 74 68 61 74 20 66 6f ession.; that fo
10990 6c 6c 6f 77 73 20 74 68 65 20 74 61 67 2e 20 47 llows the tag. G
109a0 69 76 65 6e 20 62 65 6c 6f 77 20 61 72 65 20 74 iven below are t
109b0 61 67 73 20 61 6e 64 20 73 69 67 6e 61 74 75 72 ags and signatur
109c0 65 73 20 6f 66 20 74 68 65 0a 3b 20 63 6f 72 72 es of the.; corr
109d0 65 73 70 6f 6e 64 69 6e 67 20 70 72 6f 63 65 64 esponding proced
109e0 75 72 65 73 2e 20 4e 6f 74 20 61 6c 6c 20 74 61 ures. Not all ta
109f0 67 73 20 68 61 76 65 20 74 6f 20 62 65 20 73 70 gs have to be sp
10a00 65 63 69 66 69 65 64 2e 20 49 66 20 73 6f 6d 65 ecified. If some
10a10 0a 3b 20 61 72 65 20 6f 6d 69 74 74 65 64 2c 20 .; are omitted,
10a20 72 65 61 73 6f 6e 61 62 6c 65 20 64 65 66 61 75 reasonable defau
10a30 6c 74 73 20 77 69 6c 6c 20 61 70 70 6c 79 2e 0a lts will apply..
10a40 3b 0a 0a 3b 20 74 61 67 3a 20 44 4f 43 54 59 50 ;..; tag: DOCTYP
10a50 45 0a 3b 20 68 61 6e 64 6c 65 72 2d 70 72 6f 63 E.; handler-proc
10a60 65 64 75 72 65 3a 20 50 4f 52 54 20 44 4f 43 4e edure: PORT DOCN
10a70 41 4d 45 20 53 59 53 54 45 4d 49 44 20 49 4e 54 AME SYSTEMID INT
10a80 45 52 4e 41 4c 2d 53 55 42 53 45 54 3f 20 53 45 ERNAL-SUBSET? SE
10a90 45 44 0a 3b 20 49 66 20 69 6e 74 65 72 6e 61 6c ED.; If internal
10aa0 2d 73 75 62 73 65 74 3f 20 69 73 20 23 74 2c 20 -subset? is #t,
10ab0 74 68 65 20 63 75 72 72 65 6e 74 20 70 6f 73 69 the current posi
10ac0 74 69 6f 6e 20 69 6e 20 74 68 65 20 70 6f 72 74 tion in the port
10ad0 0a 3b 20 69 73 20 72 69 67 68 74 20 61 66 74 65 .; is right afte
10ae0 72 20 77 65 20 68 61 76 65 20 72 65 61 64 20 23 r we have read #
10af0 5c 5b 20 74 68 61 74 20 62 65 67 69 6e 73 20 74 \[ that begins t
10b00 68 65 20 69 6e 74 65 72 6e 61 6c 20 44 54 44 20 he internal DTD
10b10 73 75 62 73 65 74 2e 0a 3b 20 57 65 20 6d 75 73 subset..; We mus
10b20 74 20 66 69 6e 69 73 68 20 72 65 61 64 69 6e 67 t finish reading
10b30 20 6f 66 20 74 68 69 73 20 73 75 62 73 65 74 20 of this subset
10b40 62 65 66 6f 72 65 20 77 65 20 72 65 74 75 72 6e before we return
10b50 0a 3b 20 28 6f 72 20 6d 75 73 74 20 63 61 6c 6c .; (or must call
10b60 20 73 6b 69 70 2d 69 6e 74 65 72 6e 61 6c 2d 73 skip-internal-s
10b70 75 62 73 65 74 20 69 66 20 77 65 20 61 72 65 6e ubset if we aren
10b80 27 74 20 69 6e 74 65 72 65 73 74 65 64 20 69 6e 't interested in
10b90 20 72 65 61 64 69 6e 67 20 69 74 29 2e 0a 3b 20 reading it)..;
10ba0 54 68 65 20 70 6f 72 74 20 61 74 20 65 78 69 74 The port at exit
10bb0 20 6d 75 73 74 20 62 65 20 61 74 20 74 68 65 20 must be at the
10bc0 66 69 72 73 74 20 73 79 6d 62 6f 6c 20 61 66 74 first symbol aft
10bd0 65 72 20 74 68 65 20 77 68 6f 6c 65 0a 3b 20 44 er the whole.; D
10be0 4f 43 54 59 50 45 20 64 65 63 6c 61 72 61 74 69 OCTYPE declarati
10bf0 6f 6e 2e 0a 3b 20 54 68 65 20 68 61 6e 64 6c 65 on..; The handle
10c00 72 2d 70 72 6f 63 65 64 75 72 65 20 6d 75 73 74 r-procedure must
10c10 20 67 65 6e 65 72 61 74 65 20 66 6f 75 72 20 76 generate four v
10c20 61 6c 75 65 73 3a 0a 3b 09 45 4c 45 4d 53 20 45 alues:.;.ELEMS E
10c30 4e 54 49 54 49 45 53 20 4e 41 4d 45 53 50 41 43 NTITIES NAMESPAC
10c40 45 53 20 53 45 45 44 0a 3b 20 53 65 65 20 78 6d ES SEED.; See xm
10c50 6c 2d 64 65 63 6c 3a 3a 65 6c 65 6d 73 20 66 6f l-decl::elems fo
10c60 72 20 45 4c 45 4d 53 2e 20 49 74 20 6d 61 79 20 r ELEMS. It may
10c70 62 65 20 23 66 20 74 6f 20 73 77 69 74 63 68 20 be #f to switch
10c80 6f 66 66 20 74 68 65 20 76 61 6c 69 64 61 74 69 off the validati
10c90 6f 6e 2e 0a 3b 20 4e 41 4d 45 53 50 41 43 45 53 on..; NAMESPACES
10ca0 20 77 69 6c 6c 20 74 79 70 69 63 61 6c 6c 79 20 will typically
10cb0 63 6f 6e 74 61 69 6e 20 55 53 45 52 2d 50 52 45 contain USER-PRE
10cc0 46 49 58 65 73 20 66 6f 72 20 73 65 6c 65 63 74 FIXes for select
10cd0 65 64 20 55 52 49 2d 53 59 4d 42 73 2e 0a 3b 20 ed URI-SYMBs..;
10ce0 54 68 65 20 64 65 66 61 75 6c 74 20 68 61 6e 64 The default hand
10cf0 6c 65 72 2d 70 72 6f 63 65 64 75 72 65 20 73 6b ler-procedure sk
10d00 69 70 73 20 74 68 65 20 69 6e 74 65 72 6e 61 6c ips the internal
10d10 20 73 75 62 73 65 74 2c 0a 3b 20 69 66 20 61 6e subset,.; if an
10d20 79 2c 20 61 6e 64 20 72 65 74 75 72 6e 73 20 28 y, and returns (
10d30 76 61 6c 75 65 73 20 23 66 20 27 28 29 20 27 28 values #f '() '(
10d40 29 20 73 65 65 64 29 0a 0a 3b 20 74 61 67 3a 20 ) seed)..; tag:
10d50 55 4e 44 45 43 4c 2d 52 4f 4f 54 0a 3b 20 68 61 UNDECL-ROOT.; ha
10d60 6e 64 6c 65 72 2d 70 72 6f 63 65 64 75 72 65 3a ndler-procedure:
10d70 20 45 4c 45 4d 2d 47 49 20 53 45 45 44 0a 3b 20 ELEM-GI SEED.;
10d80 77 68 65 72 65 20 45 4c 45 4d 2d 47 49 20 69 73 where ELEM-GI is
10d90 20 61 6e 20 55 4e 52 45 53 2d 4e 41 4d 45 20 6f an UNRES-NAME o
10da0 66 20 74 68 65 20 72 6f 6f 74 20 65 6c 65 6d 65 f the root eleme
10db0 6e 74 2e 20 54 68 69 73 20 70 72 6f 63 65 64 75 nt. This procedu
10dc0 72 65 0a 3b 20 69 73 20 63 61 6c 6c 65 64 20 77 re.; is called w
10dd0 68 65 6e 20 61 6e 20 58 4d 4c 20 64 6f 63 75 6d hen an XML docum
10de0 65 6e 74 20 75 6e 64 65 72 20 70 61 72 73 69 6e ent under parsin
10df0 67 20 63 6f 6e 74 61 69 6e 73 20 5f 6e 6f 5f 20 g contains _no_
10e00 44 4f 43 54 59 50 45 0a 3b 20 64 65 63 6c 61 72 DOCTYPE.; declar
10e10 61 74 69 6f 6e 2e 0a 3b 20 54 68 65 20 68 61 6e ation..; The han
10e20 64 6c 65 72 2d 70 72 6f 63 65 64 75 72 65 2c 20 dler-procedure,
10e30 61 73 20 61 20 44 4f 43 54 59 50 45 20 68 61 6e as a DOCTYPE han
10e40 64 6c 65 72 20 70 72 6f 63 65 64 75 72 65 20 61 dler procedure a
10e50 62 6f 76 65 2c 0a 3b 20 6d 75 73 74 20 67 65 6e bove,.; must gen
10e60 65 72 61 74 65 20 66 6f 75 72 20 76 61 6c 75 65 erate four value
10e70 73 3a 0a 3b 09 45 4c 45 4d 53 20 45 4e 54 49 54 s:.;.ELEMS ENTIT
10e80 49 45 53 20 4e 41 4d 45 53 50 41 43 45 53 20 53 IES NAMESPACES S
10e90 45 45 44 0a 3b 20 54 68 65 20 64 65 66 61 75 6c EED.; The defaul
10ea0 74 20 68 61 6e 64 6c 65 72 2d 70 72 6f 63 65 64 t handler-proced
10eb0 75 72 65 20 72 65 74 75 72 6e 73 20 28 76 61 6c ure returns (val
10ec0 75 65 73 20 23 66 20 27 28 29 20 27 28 29 20 73 ues #f '() '() s
10ed0 65 65 64 29 0a 0a 3b 20 74 61 67 3a 20 44 45 43 eed)..; tag: DEC
10ee0 4c 2d 52 4f 4f 54 0a 3b 20 68 61 6e 64 6c 65 72 L-ROOT.; handler
10ef0 2d 70 72 6f 63 65 64 75 72 65 3a 20 45 4c 45 4d -procedure: ELEM
10f00 2d 47 49 20 53 45 45 44 0a 3b 20 77 68 65 72 65 -GI SEED.; where
10f10 20 45 4c 45 4d 2d 47 49 20 69 73 20 61 6e 20 55 ELEM-GI is an U
10f20 4e 52 45 53 2d 4e 41 4d 45 20 6f 66 20 74 68 65 NRES-NAME of the
10f30 20 72 6f 6f 74 20 65 6c 65 6d 65 6e 74 2e 20 54 root element. T
10f40 68 69 73 20 70 72 6f 63 65 64 75 72 65 0a 3b 20 his procedure.;
10f50 69 73 20 63 61 6c 6c 65 64 20 77 68 65 6e 20 61 is called when a
10f60 6e 20 58 4d 4c 20 64 6f 63 75 6d 65 6e 74 20 75 n XML document u
10f70 6e 64 65 72 20 70 61 72 73 69 6e 67 20 64 6f 65 nder parsing doe
10f80 73 20 63 6f 6e 74 61 69 6e 73 20 74 68 65 20 44 s contains the D
10f90 4f 43 54 59 50 45 0a 3b 20 64 65 63 6c 61 72 61 OCTYPE.; declara
10fa0 74 69 6f 6e 2e 0a 3b 20 54 68 65 20 68 61 6e 64 tion..; The hand
10fb0 6c 65 72 2d 70 72 6f 63 65 64 75 72 65 20 6d 75 ler-procedure mu
10fc0 73 74 20 67 65 6e 65 72 61 74 65 20 61 20 6e 65 st generate a ne
10fd0 77 20 53 45 45 44 20 28 61 6e 64 20 76 65 72 69 w SEED (and veri
10fe0 66 79 0a 3b 20 74 68 61 74 20 74 68 65 20 6e 61 fy.; that the na
10ff0 6d 65 20 6f 66 20 74 68 65 20 72 6f 6f 74 20 65 me of the root e
11000 6c 65 6d 65 6e 74 20 6d 61 74 63 68 65 73 20 74 lement matches t
11010 68 65 20 64 6f 63 74 79 70 65 2c 20 69 66 20 74 he doctype, if t
11020 68 65 20 68 61 6e 64 6c 65 72 0a 3b 20 73 6f 20 he handler.; so
11030 77 69 73 68 65 73 29 2e 20 0a 3b 20 54 68 65 20 wishes). .; The
11040 64 65 66 61 75 6c 74 20 68 61 6e 64 6c 65 72 2d default handler-
11050 70 72 6f 63 65 64 75 72 65 20 69 73 20 74 68 65 procedure is the
11060 20 69 64 65 6e 74 69 74 79 20 66 75 6e 63 74 69 identity functi
11070 6f 6e 2e 0a 0a 3b 20 74 61 67 3a 20 4e 45 57 2d on...; tag: NEW-
11080 4c 45 56 45 4c 2d 53 45 45 44 0a 3b 20 68 61 6e LEVEL-SEED.; han
11090 64 6c 65 72 2d 70 72 6f 63 65 64 75 72 65 3a 20 dler-procedure:
110a0 73 65 65 20 73 73 61 78 3a 6d 61 6b 65 2d 65 6c see ssax:make-el
110b0 65 6d 2d 70 61 72 73 65 72 2c 20 6d 79 2d 6e 65 em-parser, my-ne
110c0 77 2d 6c 65 76 65 6c 2d 73 65 65 64 0a 0a 3b 20 w-level-seed..;
110d0 74 61 67 3a 20 46 49 4e 49 53 48 2d 45 4c 45 4d tag: FINISH-ELEM
110e0 45 4e 54 0a 3b 20 68 61 6e 64 6c 65 72 2d 70 72 ENT.; handler-pr
110f0 6f 63 65 64 75 72 65 3a 20 73 65 65 20 73 73 61 ocedure: see ssa
11100 78 3a 6d 61 6b 65 2d 65 6c 65 6d 2d 70 61 72 73 x:make-elem-pars
11110 65 72 2c 20 6d 79 2d 66 69 6e 69 73 68 2d 65 6c er, my-finish-el
11120 65 6d 65 6e 74 0a 0a 3b 20 74 61 67 3a 20 43 48 ement..; tag: CH
11130 41 52 2d 44 41 54 41 2d 48 41 4e 44 4c 45 52 0a AR-DATA-HANDLER.
11140 3b 20 68 61 6e 64 6c 65 72 2d 70 72 6f 63 65 64 ; handler-proced
11150 75 72 65 3a 20 73 65 65 20 73 73 61 78 3a 6d 61 ure: see ssax:ma
11160 6b 65 2d 65 6c 65 6d 2d 70 61 72 73 65 72 2c 20 ke-elem-parser,
11170 6d 79 2d 63 68 61 72 2d 64 61 74 61 2d 68 61 6e my-char-data-han
11180 64 6c 65 72 0a 0a 3b 20 74 61 67 3a 20 50 49 0a dler..; tag: PI.
11190 3b 20 68 61 6e 64 6c 65 72 2d 70 72 6f 63 65 64 ; handler-proced
111a0 75 72 65 3a 20 73 65 65 20 73 73 61 78 3a 6d 61 ure: see ssax:ma
111b0 6b 65 2d 70 69 2d 70 61 72 73 65 72 0a 3b 20 54 ke-pi-parser.; T
111c0 68 65 20 64 65 66 61 75 6c 74 20 76 61 6c 75 65 he default value
111d0 20 69 73 20 27 28 29 0a 20 0a 3b 20 54 68 65 20 is '(). .; The
111e0 67 65 6e 65 72 61 74 65 64 20 70 61 72 73 65 72 generated parser
111f0 20 69 73 20 61 0a 3b 09 70 72 6f 63 65 64 75 72 is a.;.procedur
11200 65 20 50 4f 52 54 20 53 45 45 44 0a 0a 3b 20 54 e PORT SEED..; T
11210 68 69 73 20 70 72 6f 63 65 64 75 72 65 20 70 61 his procedure pa
11220 72 73 65 73 20 74 68 65 20 64 6f 63 75 6d 65 6e rses the documen
11230 74 20 70 72 6f 6c 6f 67 20 61 6e 64 20 74 68 65 t prolog and the
11240 6e 20 65 78 69 74 73 20 74 6f 0a 3b 20 61 6e 20 n exits to.; an
11250 65 6c 65 6d 65 6e 74 20 70 61 72 73 65 72 20 28 element parser (
11260 63 72 65 61 74 65 64 20 62 79 20 73 73 61 78 3a created by ssax:
11270 6d 61 6b 65 2d 65 6c 65 6d 2d 70 61 72 73 65 72 make-elem-parser
11280 29 20 74 6f 20 68 61 6e 64 6c 65 0a 3b 20 74 68 ) to handle.; th
11290 65 20 72 65 73 74 2e 0a 3b 0a 3b 20 5b 31 5d 20 e rest..;.; [1]
112a0 20 64 6f 63 75 6d 65 6e 74 20 3a 3a 3d 20 20 70 document ::= p
112b0 72 6f 6c 6f 67 20 65 6c 65 6d 65 6e 74 20 4d 69 rolog element Mi
112c0 73 63 2a 0a 3b 20 5b 32 32 5d 20 70 72 6f 6c 6f sc*.; [22] prolo
112d0 67 20 3a 3a 3d 20 58 4d 4c 44 65 63 6c 3f 20 4d g ::= XMLDecl? M
112e0 69 73 63 2a 20 28 64 6f 63 74 79 70 65 64 65 63 isc* (doctypedec
112f0 20 7c 20 4d 69 73 63 2a 29 3f 0a 3b 20 5b 32 37 | Misc*)?.; [27
11300 5d 20 4d 69 73 63 20 3a 3a 3d 20 43 6f 6d 6d 65 ] Misc ::= Comme
11310 6e 74 20 7c 20 50 49 20 7c 20 20 53 0a 3b 0a 3b nt | PI | S.;.;
11320 20 5b 32 38 5d 20 64 6f 63 74 79 70 65 64 65 63 [28] doctypedec
11330 6c 20 3a 3a 3d 20 20 27 3c 21 44 4f 43 54 59 50 l ::= '<!DOCTYP
11340 45 27 20 53 20 4e 61 6d 65 20 28 53 20 45 78 74 E' S Name (S Ext
11350 65 72 6e 61 6c 49 44 29 3f 20 53 3f 20 0a 3b 09 ernalID)? S? .;.
11360 09 09 28 27 5b 27 20 28 6d 61 72 6b 75 70 64 65 ..('[' (markupde
11370 63 6c 20 7c 20 50 45 52 65 66 65 72 65 6e 63 65 cl | PEReference
11380 20 7c 20 53 29 2a 20 27 5d 27 20 53 3f 29 3f 20 | S)* ']' S?)?
11390 27 3e 27 0a 3b 20 5b 32 39 5d 20 6d 61 72 6b 75 '>'.; [29] marku
113a0 70 64 65 63 6c 20 3a 3a 3d 20 65 6c 65 6d 65 6e pdecl ::= elemen
113b0 74 64 65 63 6c 20 7c 20 41 74 74 6c 69 73 74 44 tdecl | AttlistD
113c0 65 63 6c 0a 3b 20 20 20 20 20 20 20 20 20 20 20 ecl.;
113d0 20 20 20 20 20 20 20 20 20 20 20 7c 20 45 6e 74 | Ent
113e0 69 74 79 44 65 63 6c 0a 3b 20 20 20 20 20 20 20 ityDecl.;
113f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 7c |
11400 20 4e 6f 74 61 74 69 6f 6e 44 65 63 6c 20 7c 20 NotationDecl |
11410 50 49 0a 3b 20 20 20 20 20 20 20 20 20 20 20 20 PI.;
11420 20 20 20 20 20 20 20 20 20 20 7c 20 43 6f 6d 6d | Comm
11430 65 6e 74 20 0a 3b 0a 0a 0a 3b 20 54 68 69 73 20 ent .;...; This
11440 69 73 20 73 73 61 78 3a 6d 61 6b 65 2d 70 61 72 is ssax:make-par
11450 73 65 72 20 77 69 74 68 20 61 6c 6c 20 74 68 65 ser with all the
11460 20 28 73 70 65 63 69 61 6c 69 7a 61 74 69 6f 6e (specialization
11470 29 20 68 61 6e 64 6c 65 72 73 20 67 69 76 65 6e ) handlers given
11480 0a 3b 20 61 73 20 70 6f 73 69 74 69 6f 6e 61 6c .; as positional
11490 20 61 72 67 75 6d 65 6e 74 73 2e 20 49 74 20 69 arguments. It i
114a0 73 20 63 61 6c 6c 65 64 20 62 79 20 73 73 61 78 s called by ssax
114b0 3a 6d 61 6b 65 2d 70 61 72 73 65 72 2c 20 73 65 :make-parser, se
114c0 65 20 62 65 6c 6f 77 0a 28 64 65 66 69 6e 65 2d e below.(define-
114d0 73 79 6e 74 61 78 20 73 73 61 78 3a 6d 61 6b 65 syntax ssax:make
114e0 2d 70 61 72 73 65 72 2f 70 6f 73 69 74 69 6f 6e -parser/position
114f0 61 6c 2d 61 72 67 73 0a 20 20 28 73 79 6e 74 61 al-args. (synta
11500 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 x-rules (). (
11510 28 73 73 61 78 3a 6d 61 6b 65 2d 70 61 72 73 65 (ssax:make-parse
11520 72 2f 70 6f 73 69 74 69 6f 6e 61 6c 2d 61 72 67 r/positional-arg
11530 73 0a 20 20 20 20 20 20 20 2a 68 61 6e 64 6c 65 s. *handle
11540 72 2d 44 4f 43 54 59 50 45 0a 20 20 20 20 20 20 r-DOCTYPE.
11550 20 2a 68 61 6e 64 6c 65 72 2d 55 4e 44 45 43 4c *handler-UNDECL
11560 2d 52 4f 4f 54 0a 20 20 20 20 20 20 20 2a 68 61 -ROOT. *ha
11570 6e 64 6c 65 72 2d 44 45 43 4c 2d 52 4f 4f 54 0a ndler-DECL-ROOT.
11580 20 20 20 20 20 20 20 2a 68 61 6e 64 6c 65 72 2d *handler-
11590 4e 45 57 2d 4c 45 56 45 4c 2d 53 45 45 44 0a 20 NEW-LEVEL-SEED.
115a0 20 20 20 20 20 20 2a 68 61 6e 64 6c 65 72 2d 46 *handler-F
115b0 49 4e 49 53 48 2d 45 4c 45 4d 45 4e 54 0a 20 20 INISH-ELEMENT.
115c0 20 20 20 20 20 2a 68 61 6e 64 6c 65 72 2d 43 48 *handler-CH
115d0 41 52 2d 44 41 54 41 2d 48 41 4e 44 4c 45 52 0a AR-DATA-HANDLER.
115e0 20 20 20 20 20 20 20 2a 68 61 6e 64 6c 65 72 2d *handler-
115f0 50 49 29 0a 20 20 28 6c 61 6d 62 64 61 20 28 70 PI). (lambda (p
11600 6f 72 74 20 73 65 65 64 29 0a 0a 20 20 20 20 20 ort seed)..
11610 3b 20 57 65 20 6d 75 73 74 27 76 65 20 6a 75 73 ; We must've jus
11620 74 20 73 63 61 6e 6e 65 64 20 74 68 65 20 44 4f t scanned the DO
11630 43 54 59 50 45 20 74 6f 6b 65 6e 20 0a 20 20 20 CTYPE token .
11640 20 20 3b 20 48 61 6e 64 6c 65 20 74 68 65 20 64 ; Handle the d
11650 6f 63 74 79 70 65 20 64 65 63 6c 61 72 61 74 69 octype declarati
11660 6f 6e 20 61 6e 64 20 65 78 69 74 20 74 6f 0a 20 on and exit to.
11670 20 20 20 20 3b 20 73 63 61 6e 2d 66 6f 72 2d 73 ; scan-for-s
11680 69 67 6e 69 66 69 63 61 6e 74 2d 70 72 6f 6c 6f ignificant-prolo
11690 67 2d 74 6f 6b 65 6e 2d 32 2c 20 61 6e 64 20 65 g-token-2, and e
116a0 76 65 6e 74 75 61 6c 6c 79 2c 20 74 6f 20 74 68 ventually, to th
116b0 65 0a 20 20 20 20 20 3b 20 65 6c 65 6d 65 6e 74 e. ; element
116c0 20 70 61 72 73 65 72 2e 0a 20 20 20 20 20 28 64 parser.. (d
116d0 65 66 69 6e 65 20 28 68 61 6e 64 6c 65 2d 64 65 efine (handle-de
116e0 63 6c 20 70 6f 72 74 20 74 6f 6b 65 6e 2d 68 65 cl port token-he
116f0 61 64 20 73 65 65 64 29 0a 20 20 20 20 20 20 20 ad seed).
11700 28 6f 72 20 28 65 71 3f 20 28 73 74 72 69 6e 67 (or (eq? (string
11710 2d 3e 73 79 6d 62 6f 6c 20 22 44 4f 43 54 59 50 ->symbol "DOCTYP
11720 45 22 29 20 74 6f 6b 65 6e 2d 68 65 61 64 29 0a E") token-head).
11730 09 20 20 20 28 70 61 72 73 65 72 2d 65 72 72 6f . (parser-erro
11740 72 20 70 6f 72 74 20 22 58 4d 4c 20 5b 32 32 5d r port "XML [22]
11750 2c 20 65 78 70 65 63 74 65 64 20 44 4f 43 54 59 , expected DOCTY
11760 50 45 20 64 65 63 6c 61 72 61 74 69 6f 6e 2c 20 PE declaration,
11770 66 6f 75 6e 64 20 22 0a 09 09 20 20 74 6f 6b 65 found "... toke
11780 6e 2d 68 65 61 64 29 29 0a 20 20 20 20 20 20 20 n-head)).
11790 28 61 73 73 65 72 74 2d 63 75 72 72 2d 63 68 61 (assert-curr-cha
117a0 72 20 73 73 61 78 3a 53 2d 63 68 61 72 73 20 22 r ssax:S-chars "
117b0 58 4d 4c 20 5b 32 38 5d 2c 20 73 70 61 63 65 20 XML [28], space
117c0 61 66 74 65 72 20 44 4f 43 54 59 50 45 22 20 70 after DOCTYPE" p
117d0 6f 72 74 29 0a 20 20 20 20 20 20 20 28 73 73 61 ort). (ssa
117e0 78 3a 73 6b 69 70 2d 53 20 70 6f 72 74 29 0a 20 x:skip-S port).
117f0 20 20 20 20 20 20 28 6c 65 74 2a 2d 76 61 6c 75 (let*-valu
11800 65 73 0a 09 28 28 28 64 6f 63 6e 61 6d 65 29 20 es..(((docname)
11810 28 73 73 61 78 3a 72 65 61 64 2d 51 4e 61 6d 65 (ssax:read-QName
11820 20 70 6f 72 74 29 29 0a 09 20 28 28 73 79 73 74 port)).. ((syst
11830 65 6d 69 64 29 0a 09 20 20 28 61 6e 64 20 28 73 emid).. (and (s
11840 73 61 78 3a 6e 63 6e 61 6d 65 2d 73 74 61 72 74 sax:ncname-start
11850 69 6e 67 2d 63 68 61 72 3f 20 28 73 73 61 78 3a ing-char? (ssax:
11860 73 6b 69 70 2d 53 20 70 6f 72 74 29 29 0a 09 20 skip-S port))..
11870 20 20 20 20 20 20 28 73 73 61 78 3a 72 65 61 64 (ssax:read
11880 2d 65 78 74 65 72 6e 61 6c 2d 69 64 20 70 6f 72 -external-id por
11890 74 29 29 29 0a 09 20 28 28 69 6e 74 65 72 6e 61 t))).. ((interna
118a0 6c 2d 73 75 62 73 65 74 3f 29 0a 09 20 20 28 62 l-subset?).. (b
118b0 65 67 69 6e 20 28 73 73 61 78 3a 73 6b 69 70 2d egin (ssax:skip-
118c0 53 20 70 6f 72 74 29 0a 09 20 20 20 20 28 65 71 S port).. (eq
118d0 76 3f 20 23 5c 5b 20 28 61 73 73 65 72 74 2d 63 v? #\[ (assert-c
118e0 75 72 72 2d 63 68 61 72 20 27 28 23 5c 3e 20 23 urr-char '(#\> #
118f0 5c 5b 29 0a 09 09 09 09 09 22 58 4d 4c 20 5b 32 \[)......"XML [2
11900 38 5d 2c 20 65 6e 64 2d 6f 66 2d 44 4f 43 54 59 8], end-of-DOCTY
11910 50 45 22 20 70 6f 72 74 29 29 29 29 0a 09 20 28 PE" port)))).. (
11920 28 65 6c 65 6d 73 20 65 6e 74 69 74 69 65 73 20 (elems entities
11930 6e 61 6d 65 73 70 61 63 65 73 20 73 65 65 64 29 namespaces seed)
11940 0a 09 20 20 28 2a 68 61 6e 64 6c 65 72 2d 44 4f .. (*handler-DO
11950 43 54 59 50 45 20 70 6f 72 74 20 64 6f 63 6e 61 CTYPE port docna
11960 6d 65 20 73 79 73 74 65 6d 69 64 0a 09 09 09 20 me systemid....
11970 20 20 20 69 6e 74 65 72 6e 61 6c 2d 73 75 62 73 internal-subs
11980 65 74 3f 20 73 65 65 64 29 29 0a 09 20 29 0a 09 et? seed)).. )..
11990 28 73 63 61 6e 2d 66 6f 72 2d 73 69 67 6e 69 66 (scan-for-signif
119a0 69 63 61 6e 74 2d 70 72 6f 6c 6f 67 2d 74 6f 6b icant-prolog-tok
119b0 65 6e 2d 32 20 70 6f 72 74 20 65 6c 65 6d 73 20 en-2 port elems
119c0 65 6e 74 69 74 69 65 73 20 6e 61 6d 65 73 70 61 entities namespa
119d0 63 65 73 0a 09 09 09 09 09 20 20 20 20 20 73 65 ces...... se
119e0 65 64 29 29 29 0a 0a 0a 20 20 20 20 20 3b 20 53 ed)))... ; S
119f0 63 61 6e 20 74 68 65 20 6c 65 61 64 69 6e 67 20 can the leading
11a00 50 49 73 20 75 6e 74 69 6c 20 77 65 20 65 6e 63 PIs until we enc
11a10 6f 75 6e 74 65 72 20 65 69 74 68 65 72 20 61 20 ounter either a
11a20 64 6f 63 74 79 70 65 20 64 65 63 6c 61 72 61 74 doctype declarat
11a30 69 6f 6e 0a 20 20 20 20 20 3b 20 6f 72 20 61 20 ion. ; or a
11a40 73 74 61 72 74 20 74 6f 6b 65 6e 20 28 6f 66 20 start token (of
11a50 74 68 65 20 72 6f 6f 74 20 65 6c 65 6d 65 6e 74 the root element
11a60 29 0a 20 20 20 20 20 3b 20 49 6e 20 74 68 65 20 ). ; In the
11a70 6c 61 74 74 65 72 20 74 77 6f 20 63 61 73 65 73 latter two cases
11a80 2c 20 77 65 20 65 78 69 74 20 74 6f 20 74 68 65 , we exit to the
11a90 20 61 70 70 72 6f 70 72 69 61 74 65 20 63 6f 6e appropriate con
11aa0 74 69 6e 75 61 74 69 6f 6e 0a 20 20 20 20 20 28 tinuation. (
11ab0 64 65 66 69 6e 65 20 28 73 63 61 6e 2d 66 6f 72 define (scan-for
11ac0 2d 73 69 67 6e 69 66 69 63 61 6e 74 2d 70 72 6f -significant-pro
11ad0 6c 6f 67 2d 74 6f 6b 65 6e 2d 31 20 70 6f 72 74 log-token-1 port
11ae0 20 73 65 65 64 29 0a 20 20 20 20 20 20 20 28 6c seed). (l
11af0 65 74 20 28 28 74 6f 6b 65 6e 20 28 73 73 61 78 et ((token (ssax
11b00 3a 73 63 61 6e 2d 4d 69 73 63 20 70 6f 72 74 29 :scan-Misc port)
11b10 29 29 0a 09 20 28 69 66 20 28 65 6f 66 2d 6f 62 )).. (if (eof-ob
11b20 6a 65 63 74 3f 20 74 6f 6b 65 6e 29 0a 09 20 20 ject? token)..
11b30 20 20 20 28 70 61 72 73 65 72 2d 65 72 72 6f 72 (parser-error
11b40 20 70 6f 72 74 20 22 58 4d 4c 20 5b 32 32 5d 2c port "XML [22],
11b50 20 75 6e 65 78 70 65 63 74 65 64 20 45 4f 46 22 unexpected EOF"
11b60 29 0a 09 20 20 20 20 20 28 63 61 73 65 20 28 78 ).. (case (x
11b70 6d 6c 2d 74 6f 6b 65 6e 2d 6b 69 6e 64 20 74 6f ml-token-kind to
11b80 6b 65 6e 29 0a 09 20 20 20 20 20 20 20 28 28 50 ken).. ((P
11b90 49 29 0a 09 09 28 6c 65 74 20 28 28 73 65 65 64 I)...(let ((seed
11ba0 20 0a 09 09 20 20 20 20 20 20 20 28 28 73 73 61 ... ((ssa
11bb0 78 3a 6d 61 6b 65 2d 70 69 2d 70 61 72 73 65 72 x:make-pi-parser
11bc0 20 2a 68 61 6e 64 6c 65 72 2d 50 49 29 0a 09 09 *handler-PI)...
11bd0 09 70 6f 72 74 20 28 78 6d 6c 2d 74 6f 6b 65 6e .port (xml-token
11be0 2d 68 65 61 64 20 74 6f 6b 65 6e 29 20 73 65 65 -head token) see
11bf0 64 29 29 29 0a 09 09 20 20 28 73 63 61 6e 2d 66 d)))... (scan-f
11c00 6f 72 2d 73 69 67 6e 69 66 69 63 61 6e 74 2d 70 or-significant-p
11c10 72 6f 6c 6f 67 2d 74 6f 6b 65 6e 2d 31 20 70 6f rolog-token-1 po
11c20 72 74 20 73 65 65 64 29 29 29 0a 09 20 20 20 20 rt seed)))..
11c30 20 20 20 28 28 44 45 43 4c 29 20 28 68 61 6e 64 ((DECL) (hand
11c40 6c 65 2d 64 65 63 6c 20 70 6f 72 74 20 28 78 6d le-decl port (xm
11c50 6c 2d 74 6f 6b 65 6e 2d 68 65 61 64 20 74 6f 6b l-token-head tok
11c60 65 6e 29 20 73 65 65 64 29 29 0a 09 20 20 20 20 en) seed))..
11c70 20 20 20 28 28 53 54 41 52 54 29 0a 09 09 28 6c ((START)...(l
11c80 65 74 2a 2d 76 61 6c 75 65 73 0a 09 09 20 28 28 et*-values... ((
11c90 28 65 6c 65 6d 73 20 65 6e 74 69 74 69 65 73 20 (elems entities
11ca0 6e 61 6d 65 73 70 61 63 65 73 20 73 65 65 64 29 namespaces seed)
11cb0 0a 09 09 20 20 20 28 2a 68 61 6e 64 6c 65 72 2d ... (*handler-
11cc0 55 4e 44 45 43 4c 2d 52 4f 4f 54 20 28 78 6d 6c UNDECL-ROOT (xml
11cd0 2d 74 6f 6b 65 6e 2d 68 65 61 64 20 74 6f 6b 65 -token-head toke
11ce0 6e 29 20 73 65 65 64 29 29 29 0a 09 09 20 28 65 n) seed)))... (e
11cf0 6c 65 6d 65 6e 74 2d 70 61 72 73 65 72 20 28 78 lement-parser (x
11d00 6d 6c 2d 74 6f 6b 65 6e 2d 68 65 61 64 20 74 6f ml-token-head to
11d10 6b 65 6e 29 20 70 6f 72 74 20 65 6c 65 6d 73 0a ken) port elems.
11d20 09 09 09 09 20 65 6e 74 69 74 69 65 73 20 6e 61 .... entities na
11d30 6d 65 73 70 61 63 65 73 20 23 66 20 73 65 65 64 mespaces #f seed
11d40 29 29 29 0a 09 20 20 20 20 20 20 20 28 65 6c 73 ))).. (els
11d50 65 20 28 70 61 72 73 65 72 2d 65 72 72 6f 72 20 e (parser-error
11d60 70 6f 72 74 20 22 58 4d 4c 20 5b 32 32 5d 2c 20 port "XML [22],
11d70 75 6e 65 78 70 65 63 74 65 64 20 6d 61 72 6b 75 unexpected marku
11d80 70 20 22 0a 09 09 09 09 20 20 20 74 6f 6b 65 6e p "..... token
11d90 29 29 29 29 29 29 0a 0a 0a 20 20 20 20 20 3b 20 ))))))... ;
11da0 53 63 61 6e 20 50 49 73 20 61 66 74 65 72 20 74 Scan PIs after t
11db0 68 65 20 64 6f 63 74 79 70 65 20 64 65 63 6c 61 he doctype decla
11dc0 72 61 74 69 6f 6e 2c 20 74 69 6c 6c 20 77 65 20 ration, till we
11dd0 65 6e 63 6f 75 6e 74 65 72 0a 20 20 20 20 20 3b encounter. ;
11de0 20 74 68 65 20 73 74 61 72 74 20 74 61 67 20 6f the start tag o
11df0 66 20 74 68 65 20 72 6f 6f 74 20 65 6c 65 6d 65 f the root eleme
11e00 6e 74 2e 20 41 66 74 65 72 20 74 68 61 74 20 77 nt. After that w
11e10 65 20 65 78 69 74 0a 20 20 20 20 20 3b 20 74 6f e exit. ; to
11e20 20 74 68 65 20 65 6c 65 6d 65 6e 74 20 70 61 72 the element par
11e30 73 65 72 0a 20 20 20 20 20 28 64 65 66 69 6e 65 ser. (define
11e40 20 28 73 63 61 6e 2d 66 6f 72 2d 73 69 67 6e 69 (scan-for-signi
11e50 66 69 63 61 6e 74 2d 70 72 6f 6c 6f 67 2d 74 6f ficant-prolog-to
11e60 6b 65 6e 2d 32 20 70 6f 72 74 20 65 6c 65 6d 73 ken-2 port elems
11e70 20 65 6e 74 69 74 69 65 73 0a 09 09 09 09 09 09 entities.......
11e80 20 20 6e 61 6d 65 73 70 61 63 65 73 20 73 65 65 namespaces see
11e90 64 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 d). (let (
11ea0 28 74 6f 6b 65 6e 20 28 73 73 61 78 3a 73 63 61 (token (ssax:sca
11eb0 6e 2d 4d 69 73 63 20 70 6f 72 74 29 29 29 0a 09 n-Misc port)))..
11ec0 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 (if (eof-object
11ed0 3f 20 74 6f 6b 65 6e 29 0a 09 20 20 20 20 20 28 ? token).. (
11ee0 70 61 72 73 65 72 2d 65 72 72 6f 72 20 70 6f 72 parser-error por
11ef0 74 20 22 58 4d 4c 20 5b 32 32 5d 2c 20 75 6e 65 t "XML [22], une
11f00 78 70 65 63 74 65 64 20 45 4f 46 22 29 0a 09 20 xpected EOF")..
11f10 20 20 20 20 28 63 61 73 65 20 28 78 6d 6c 2d 74 (case (xml-t
11f20 6f 6b 65 6e 2d 6b 69 6e 64 20 74 6f 6b 65 6e 29 oken-kind token)
11f30 0a 09 20 20 20 20 20 20 20 28 28 50 49 29 0a 09 .. ((PI)..
11f40 09 28 6c 65 74 20 28 28 73 65 65 64 20 0a 09 09 .(let ((seed ...
11f50 20 20 20 20 20 20 20 28 28 73 73 61 78 3a 6d 61 ((ssax:ma
11f60 6b 65 2d 70 69 2d 70 61 72 73 65 72 20 2a 68 61 ke-pi-parser *ha
11f70 6e 64 6c 65 72 2d 50 49 29 0a 09 09 09 70 6f 72 ndler-PI)....por
11f80 74 20 28 78 6d 6c 2d 74 6f 6b 65 6e 2d 68 65 61 t (xml-token-hea
11f90 64 20 74 6f 6b 65 6e 29 20 73 65 65 64 29 29 29 d token) seed)))
11fa0 0a 09 09 20 20 28 73 63 61 6e 2d 66 6f 72 2d 73 ... (scan-for-s
11fb0 69 67 6e 69 66 69 63 61 6e 74 2d 70 72 6f 6c 6f ignificant-prolo
11fc0 67 2d 74 6f 6b 65 6e 2d 32 20 70 6f 72 74 20 65 g-token-2 port e
11fd0 6c 65 6d 73 20 65 6e 74 69 74 69 65 73 0a 09 09 lems entities...
11fe0 09 09 09 09 20 20 20 20 20 20 20 6e 61 6d 65 73 .... names
11ff0 70 61 63 65 73 20 73 65 65 64 29 29 29 0a 09 20 paces seed)))..
12000 20 20 20 20 20 20 28 28 53 54 41 52 54 29 0a 09 ((START)..
12010 09 28 65 6c 65 6d 65 6e 74 2d 70 61 72 73 65 72 .(element-parser
12020 20 28 78 6d 6c 2d 74 6f 6b 65 6e 2d 68 65 61 64 (xml-token-head
12030 20 74 6f 6b 65 6e 29 20 70 6f 72 74 20 65 6c 65 token) port ele
12040 6d 73 0a 09 09 20 20 65 6e 74 69 74 69 65 73 20 ms... entities
12050 6e 61 6d 65 73 70 61 63 65 73 20 23 66 0a 09 09 namespaces #f...
12060 20 20 28 2a 68 61 6e 64 6c 65 72 2d 44 45 43 4c (*handler-DECL
12070 2d 52 4f 4f 54 20 28 78 6d 6c 2d 74 6f 6b 65 6e -ROOT (xml-token
12080 2d 68 65 61 64 20 74 6f 6b 65 6e 29 20 73 65 65 -head token) see
12090 64 29 29 29 0a 09 20 20 20 20 20 20 20 28 65 6c d))).. (el
120a0 73 65 20 28 70 61 72 73 65 72 2d 65 72 72 6f 72 se (parser-error
120b0 20 70 6f 72 74 20 22 58 4d 4c 20 5b 32 32 5d 2c port "XML [22],
120c0 20 75 6e 65 78 70 65 63 74 65 64 20 6d 61 72 6b unexpected mark
120d0 75 70 20 22 0a 09 09 09 09 20 20 20 74 6f 6b 65 up "..... toke
120e0 6e 29 29 29 29 29 29 0a 0a 0a 20 20 20 20 20 3b n))))))... ;
120f0 20 41 20 70 72 6f 63 65 64 75 72 65 20 73 74 61 A procedure sta
12100 72 74 2d 74 61 67 2d 68 65 61 64 20 70 6f 72 74 rt-tag-head port
12110 20 65 6c 65 6d 73 20 65 6e 74 69 74 69 65 73 20 elems entities
12120 6e 61 6d 65 73 70 61 63 65 73 0a 20 20 20 20 20 namespaces.
12130 3b 09 09 20 70 72 65 73 65 72 76 65 2d 77 73 3f ;.. preserve-ws?
12140 20 73 65 65 64 0a 20 20 20 20 20 28 64 65 66 69 seed. (defi
12150 6e 65 20 65 6c 65 6d 65 6e 74 2d 70 61 72 73 65 ne element-parse
12160 72 0a 20 20 20 20 20 20 20 28 73 73 61 78 3a 6d r. (ssax:m
12170 61 6b 65 2d 65 6c 65 6d 2d 70 61 72 73 65 72 20 ake-elem-parser
12180 2a 68 61 6e 64 6c 65 72 2d 4e 45 57 2d 4c 45 56 *handler-NEW-LEV
12190 45 4c 2d 53 45 45 44 0a 09 09 09 20 20 20 20 20 EL-SEED....
121a0 20 2a 68 61 6e 64 6c 65 72 2d 46 49 4e 49 53 48 *handler-FINISH
121b0 2d 45 4c 45 4d 45 4e 54 0a 09 09 09 20 20 20 20 -ELEMENT....
121c0 20 20 2a 68 61 6e 64 6c 65 72 2d 43 48 41 52 2d *handler-CHAR-
121d0 44 41 54 41 2d 48 41 4e 44 4c 45 52 0a 09 09 09 DATA-HANDLER....
121e0 20 20 20 20 20 20 2a 68 61 6e 64 6c 65 72 2d 50 *handler-P
121f0 49 29 29 0a 0a 20 20 20 20 20 3b 20 47 65 74 20 I)).. ; Get
12200 74 68 65 20 62 61 6c 6c 20 72 6f 6c 6c 69 6e 67 the ball rolling
12210 20 2e 2e 2e 0a 20 20 20 20 20 28 73 63 61 6e 2d .... (scan-
12220 66 6f 72 2d 73 69 67 6e 69 66 69 63 61 6e 74 2d for-significant-
12230 70 72 6f 6c 6f 67 2d 74 6f 6b 65 6e 2d 31 20 70 prolog-token-1 p
12240 6f 72 74 20 73 65 65 64 29 0a 29 29 29 29 0a 0a ort seed).))))..
12250 0a 0a 3b 20 54 68 65 20 66 6f 6c 6c 6f 77 69 6e ..; The followin
12260 67 20 6d 65 74 61 2d 6d 61 63 72 6f 20 74 75 72 g meta-macro tur
12270 6e 73 20 61 20 72 65 67 75 6c 61 72 20 6d 61 63 ns a regular mac
12280 72 6f 20 28 77 69 74 68 20 70 6f 73 69 74 69 6f ro (with positio
12290 6e 61 6c 0a 3b 20 61 72 67 75 6d 65 6e 74 73 29 nal.; arguments)
122a0 20 69 6e 74 6f 20 61 20 66 6f 72 6d 20 77 69 74 into a form wit
122b0 68 20 6b 65 79 77 6f 72 64 20 28 6c 61 62 65 6c h keyword (label
122c0 65 64 29 20 61 72 67 75 6d 65 6e 74 73 2e 20 20 ed) arguments.
122d0 57 65 20 6c 61 74 65 72 0a 3b 20 75 73 65 20 74 We later.; use t
122e0 68 65 20 6d 65 74 61 2d 6d 61 63 72 6f 20 74 6f he meta-macro to
122f0 20 63 6f 6e 76 65 72 74 20 73 73 61 78 3a 6d 61 convert ssax:ma
12300 6b 65 2d 70 61 72 73 65 72 2f 70 6f 73 69 74 69 ke-parser/positi
12310 6f 6e 61 6c 2d 61 72 67 73 20 69 6e 74 6f 0a 3b onal-args into.;
12320 20 73 73 61 78 3a 6d 61 6b 65 2d 70 61 72 73 65 ssax:make-parse
12330 72 2e 20 54 68 65 20 6c 61 74 74 65 72 20 70 72 r. The latter pr
12340 6f 76 69 64 65 73 20 61 20 70 72 65 74 74 69 65 ovides a prettie
12350 72 20 28 77 69 74 68 20 6c 61 62 65 6c 65 64 0a r (with labeled.
12360 3b 20 61 72 67 75 6d 65 6e 74 73 20 61 6e 64 20 ; arguments and
12370 64 65 66 61 75 6c 74 73 29 20 69 6e 74 65 72 66 defaults) interf
12380 61 63 65 20 74 6f 0a 3b 20 73 73 61 78 3a 6d 61 ace to.; ssax:ma
12390 6b 65 2d 70 61 72 73 65 72 2f 70 6f 73 69 74 69 ke-parser/positi
123a0 6f 6e 61 6c 2d 61 72 67 73 0a 3b 0a 3b 20 73 73 onal-args.;.; ss
123b0 61 78 3a 64 65 66 69 6e 65 2d 6c 61 62 65 6c 65 ax:define-labele
123c0 64 2d 61 72 67 2d 6d 61 63 72 6f 20 4c 41 42 45 d-arg-macro LABE
123d0 4c 45 44 2d 41 52 47 2d 4d 41 43 52 4f 2d 4e 41 LED-ARG-MACRO-NA
123e0 4d 45 20 0a 3b 09 09 28 50 4f 53 2d 4d 41 43 52 ME .;..(POS-MACR
123f0 4f 2d 4e 41 4d 45 20 41 52 47 2d 44 45 53 43 52 O-NAME ARG-DESCR
12400 49 50 54 4f 52 20 2e 2e 2e 29 0a 3b 20 65 78 70 IPTOR ...).; exp
12410 61 6e 64 73 20 69 6e 74 6f 20 74 68 65 20 64 65 ands into the de
12420 66 69 6e 69 74 69 6f 6e 20 6f 66 20 61 20 6d 61 finition of a ma
12430 63 72 6f 0a 3b 09 4c 41 42 45 4c 45 44 2d 41 52 cro.;.LABELED-AR
12440 47 2d 4d 41 43 52 4f 2d 4e 41 4d 45 20 4b 57 2d G-MACRO-NAME KW-
12450 4e 41 4d 45 20 4b 57 2d 56 41 4c 55 45 20 4b 57 NAME KW-VALUE KW
12460 2d 4e 41 4d 45 31 20 4b 57 2d 56 41 4c 55 45 31 -NAME1 KW-VALUE1
12470 20 2e 2e 2e 0a 3b 20 77 68 69 63 68 2c 20 69 6e ....; which, in
12480 20 74 75 72 6e 2c 20 65 78 70 61 6e 64 73 20 69 turn, expands i
12490 6e 74 6f 0a 3b 09 50 4f 53 2d 4d 41 43 52 4f 2d nto.;.POS-MACRO-
124a0 4e 41 4d 45 20 41 52 47 31 20 41 52 47 32 20 2e NAME ARG1 ARG2 .
124b0 2e 2e 0a 3b 20 77 68 65 72 65 20 65 61 63 68 20 ...; where each
124c0 41 52 47 31 20 65 74 63 2e 20 63 6f 6d 65 73 20 ARG1 etc. comes
124d0 65 69 74 68 65 72 20 66 72 6f 6d 20 4b 57 2d 56 either from KW-V
124e0 41 4c 55 45 20 6f 72 20 66 72 6f 6d 0a 3b 20 74 ALUE or from.; t
124f0 68 65 20 64 65 61 66 75 6c 74 20 70 61 72 74 20 he deafult part
12500 6f 66 20 41 52 47 2d 44 45 53 43 52 49 50 54 4f of ARG-DESCRIPTO
12510 52 2e 20 41 52 47 31 20 63 6f 72 72 65 73 70 6f R. ARG1 correspo
12520 6e 64 73 20 74 6f 20 74 68 65 20 66 69 72 73 74 nds to the first
12530 0a 3b 20 41 52 47 2d 44 45 53 43 52 49 50 54 4f .; ARG-DESCRIPTO
12540 52 2c 20 41 52 47 32 20 63 6f 72 72 65 73 70 6f R, ARG2 correspo
12550 6e 64 73 20 74 6f 20 74 68 65 20 73 65 63 6f 6e nds to the secon
12560 64 20 64 65 73 63 72 69 70 74 6f 72 2c 20 65 74 d descriptor, et
12570 63 2e 0a 3b 20 48 65 72 65 20 41 52 47 2d 44 45 c..; Here ARG-DE
12580 53 43 52 49 50 54 4f 52 20 64 65 73 63 72 69 62 SCRIPTOR describ
12590 65 73 20 6f 6e 65 20 61 72 67 75 6d 65 6e 74 20 es one argument
125a0 6f 66 20 74 68 65 20 70 6f 73 69 74 69 6f 6e 61 of the positiona
125b0 6c 20 6d 61 63 72 6f 2e 0a 3b 20 49 74 20 68 61 l macro..; It ha
125c0 73 20 74 68 65 20 66 6f 72 6d 20 0a 3b 09 28 41 s the form .;.(A
125d0 52 47 2d 4e 41 4d 45 20 44 45 46 41 55 4c 54 2d RG-NAME DEFAULT-
125e0 56 41 4c 55 45 29 0a 3b 20 6f 72 0a 3b 09 28 41 VALUE).; or.;.(A
125f0 52 47 2d 4e 41 4d 45 29 0a 3b 20 49 6e 20 74 68 RG-NAME).; In th
12600 65 20 6c 61 74 74 65 72 20 66 6f 72 6d 2c 20 74 e latter form, t
12610 68 65 20 64 65 66 61 75 6c 74 20 76 61 6c 75 65 he default value
12620 20 69 73 20 6e 6f 74 20 67 69 76 65 6e 2c 20 73 is not given, s
12630 6f 20 74 68 61 74 20 74 68 65 20 69 6e 76 6f 63 o that the invoc
12640 61 74 69 6f 6e 20 6f 66 0a 3b 20 4c 41 42 45 4c ation of.; LABEL
12650 45 44 2d 41 52 47 2d 4d 41 43 52 4f 2d 4e 41 4d ED-ARG-MACRO-NAM
12660 45 20 6d 75 73 74 20 6d 65 6e 74 69 6f 6e 20 74 E must mention t
12670 68 65 20 63 6f 72 72 65 73 70 6f 6e 64 69 6e 67 he corresponding
12680 20 70 61 72 61 6d 65 74 65 72 2e 0a 3b 20 41 52 parameter..; AR
12690 47 2d 4e 41 4d 45 20 63 61 6e 20 62 65 20 61 6e G-NAME can be an
126a0 79 74 68 69 6e 67 3a 20 61 6e 20 69 64 65 6e 74 ything: an ident
126b0 69 66 69 65 72 2c 20 61 20 73 74 72 69 6e 67 2c ifier, a string,
126c0 20 6f 72 20 65 76 65 6e 20 61 20 6e 75 6d 62 65 or even a numbe
126d0 72 2e 0a 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e r....(define-syn
126e0 74 61 78 20 73 73 61 78 3a 64 65 66 69 6e 65 2d tax ssax:define-
126f0 6c 61 62 65 6c 65 64 2d 61 72 67 2d 6d 61 63 72 labeled-arg-macr
12700 6f 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 o. (syntax-rule
12710 73 20 28 29 0a 20 20 20 20 28 28 73 73 61 78 3a s (). ((ssax:
12720 64 65 66 69 6e 65 2d 6c 61 62 65 6c 65 64 2d 61 define-labeled-a
12730 72 67 2d 6d 61 63 72 6f 0a 20 20 20 20 20 20 20 rg-macro.
12740 6c 61 62 65 6c 65 64 2d 61 72 67 2d 6d 61 63 72 labeled-arg-macr
12750 6f 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20 28 70 o-name. (p
12760 6f 73 69 74 69 6f 6e 61 6c 2d 6d 61 63 72 6f 2d ositional-macro-
12770 6e 61 6d 65 0a 09 20 28 61 72 67 2d 6e 61 6d 65 name.. (arg-name
12780 20 2e 20 61 72 67 2d 64 65 66 29 20 2e 2e 2e 29 . arg-def) ...)
12790 29 0a 20 20 20 20 20 20 28 64 65 66 69 6e 65 2d ). (define-
127a0 73 79 6e 74 61 78 20 6c 61 62 65 6c 65 64 2d 61 syntax labeled-a
127b0 72 67 2d 6d 61 63 72 6f 2d 6e 61 6d 65 0a 09 28 rg-macro-name..(
127c0 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a syntax-rules ().
127d0 09 20 20 28 28 6c 61 62 65 6c 65 64 2d 61 72 67 . ((labeled-arg
127e0 2d 6d 61 63 72 6f 2d 6e 61 6d 65 20 2e 20 6b 77 -macro-name . kw
127f0 2d 76 61 6c 2d 70 61 69 72 73 29 0a 09 20 20 20 -val-pairs)..
12800 20 28 6c 65 74 72 65 63 2d 73 79 6e 74 61 78 0a (letrec-syntax.
12810 09 20 20 20 20 20 20 28 28 66 69 6e 64 20 0a 09 . ((find ..
12820 09 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 . (syntax-rules
12830 28 61 72 67 2d 6e 61 6d 65 20 2e 2e 2e 29 0a 09 (arg-name ...)..
12840 09 20 20 20 28 28 66 69 6e 64 20 6b 2d 61 72 67 . ((find k-arg
12850 73 20 28 61 72 67 2d 6e 61 6d 65 20 2e 20 64 65 s (arg-name . de
12860 66 61 75 6c 74 29 20 61 72 67 2d 6e 61 6d 65 0a fault) arg-name.
12870 09 09 20 20 20 20 20 20 76 61 6c 20 2e 20 6f 74 .. val . ot
12880 68 65 72 73 29 09 20 20 20 3b 20 66 6f 75 6e 64 hers). ; found
12890 20 61 72 67 2d 6e 61 6d 65 20 61 6d 6f 6e 67 20 arg-name among
128a0 6b 77 2d 76 61 6c 2d 70 61 69 72 73 0a 09 09 20 kw-val-pairs...
128b0 20 20 20 28 6e 65 78 74 20 76 61 6c 20 2e 20 6b (next val . k
128c0 2d 61 72 67 73 29 29 20 2e 2e 2e 0a 09 09 20 20 -args)) ......
128d0 20 28 28 66 69 6e 64 20 6b 2d 61 72 67 73 20 6b ((find k-args k
128e0 65 79 20 61 72 67 2d 6e 6f 2d 6d 61 74 63 68 2d ey arg-no-match-
128f0 6e 61 6d 65 20 76 61 6c 20 2e 20 6f 74 68 65 72 name val . other
12900 73 29 0a 09 09 20 20 20 20 20 28 66 69 6e 64 20 s)... (find
12910 6b 2d 61 72 67 73 20 6b 65 79 20 2e 20 6f 74 68 k-args key . oth
12920 65 72 73 29 29 0a 09 09 20 20 20 28 28 66 69 6e ers))... ((fin
12930 64 20 6b 2d 61 72 67 73 20 28 61 72 67 2d 6e 61 d k-args (arg-na
12940 6d 65 20 64 65 66 61 75 6c 74 29 29 20 3b 20 64 me default)) ; d
12950 65 66 61 75 6c 74 20 6d 75 73 74 20 62 65 20 68 efault must be h
12960 65 72 65 0a 09 09 20 20 20 20 20 28 6e 65 78 74 ere... (next
12970 20 64 65 66 61 75 6c 74 20 2e 20 6b 2d 61 72 67 default . k-arg
12980 73 29 29 20 2e 2e 2e 0a 09 09 20 20 20 29 29 0a s)) ...... )).
12990 09 09 28 6e 65 78 74 09 09 09 3b 20 70 61 63 6b ..(next...; pack
129a0 20 74 68 65 20 63 6f 6e 74 69 6e 75 61 74 69 6f the continuatio
129b0 6e 20 74 6f 20 66 69 6e 64 0a 09 09 20 20 28 73 n to find... (s
129c0 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 09 yntax-rules ()..
129d0 09 20 20 20 20 28 28 6e 65 78 74 20 76 61 6c 20 . ((next val
129e0 76 61 6c 73 20 6b 65 79 20 2e 20 6b 65 79 73 29 vals key . keys)
129f0 0a 09 09 20 20 20 20 20 20 28 66 69 6e 64 20 28 ... (find (
12a00 28 76 61 6c 20 2e 20 76 61 6c 73 29 20 2e 20 6b (val . vals) . k
12a10 65 79 73 29 20 6b 65 79 20 2e 20 6b 77 2d 76 61 eys) key . kw-va
12a20 6c 2d 70 61 69 72 73 29 29 0a 09 09 20 20 20 20 l-pairs))...
12a30 28 28 6e 65 78 74 20 76 61 6c 20 76 61 6c 73 29 ((next val vals)
12a40 09 3b 20 70 72 6f 63 65 73 73 65 64 20 61 6c 6c .; processed all
12a50 20 61 72 67 2d 64 65 73 63 72 69 70 74 6f 72 73 arg-descriptors
12a60 0a 09 09 20 20 20 20 20 20 28 72 65 76 2d 61 70 ... (rev-ap
12a70 70 6c 79 20 28 76 61 6c 29 20 76 61 6c 73 29 29 ply (val) vals))
12a80 29 29 0a 09 09 28 72 65 76 2d 61 70 70 6c 79 0a ))...(rev-apply.
12a90 09 09 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 .. (syntax-rule
12aa0 73 20 28 29 0a 09 09 20 20 20 20 28 28 72 65 76 s ()... ((rev
12ab0 2d 61 70 70 6c 79 20 66 6f 72 6d 20 28 78 20 2e -apply form (x .
12ac0 20 78 73 29 29 0a 09 09 20 20 20 20 20 20 28 72 xs))... (r
12ad0 65 76 2d 61 70 70 6c 79 20 28 78 20 2e 20 66 6f ev-apply (x . fo
12ae0 72 6d 29 20 78 73 29 29 0a 09 09 20 20 20 20 28 rm) xs))... (
12af0 28 72 65 76 2d 61 70 70 6c 79 20 66 6f 72 6d 20 (rev-apply form
12b00 28 29 29 20 66 6f 72 6d 29 29 29 29 0a 09 20 20 ()) form))))..
12b10 20 20 20 20 28 6e 65 78 74 20 70 6f 73 69 74 69 (next positi
12b20 6f 6e 61 6c 2d 6d 61 63 72 6f 2d 6e 61 6d 65 20 onal-macro-name
12b30 28 29 20 0a 09 09 28 61 72 67 2d 6e 61 6d 65 20 () ...(arg-name
12b40 2e 20 61 72 67 2d 64 65 66 29 20 2e 2e 2e 29 29 . arg-def) ...))
12b50 29 29 29 29 29 29 0a 0a 0a 3b 20 54 68 65 20 64 ))))))...; The d
12b60 65 66 69 6e 69 74 69 6f 6e 20 6f 66 20 73 73 61 efinition of ssa
12b70 78 3a 6d 61 6b 65 2d 70 61 72 73 65 72 0a 28 73 x:make-parser.(s
12b80 73 61 78 3a 64 65 66 69 6e 65 2d 6c 61 62 65 6c sax:define-label
12b90 65 64 2d 61 72 67 2d 6d 61 63 72 6f 20 73 73 61 ed-arg-macro ssa
12ba0 78 3a 6d 61 6b 65 2d 70 61 72 73 65 72 0a 20 20 x:make-parser.
12bb0 28 73 73 61 78 3a 6d 61 6b 65 2d 70 61 72 73 65 (ssax:make-parse
12bc0 72 2f 70 6f 73 69 74 69 6f 6e 61 6c 2d 61 72 67 r/positional-arg
12bd0 73 0a 20 20 20 20 28 44 4f 43 54 59 50 45 0a 20 s. (DOCTYPE.
12be0 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 6f (lambda (po
12bf0 72 74 20 64 6f 63 6e 61 6d 65 20 73 79 73 74 65 rt docname syste
12c00 6d 69 64 20 69 6e 74 65 72 6e 61 6c 2d 73 75 62 mid internal-sub
12c10 73 65 74 3f 20 73 65 65 64 29 0a 09 28 77 68 65 set? seed)..(whe
12c20 6e 20 69 6e 74 65 72 6e 61 6c 2d 73 75 62 73 65 n internal-subse
12c30 74 3f 0a 09 20 20 28 73 73 61 78 3a 77 61 72 6e t?.. (ssax:warn
12c40 20 70 6f 72 74 20 22 49 6e 74 65 72 6e 61 6c 20 port "Internal
12c50 44 54 44 20 73 75 62 73 65 74 20 69 73 20 6e 6f DTD subset is no
12c60 74 20 63 75 72 72 65 6e 74 6c 79 20 68 61 6e 64 t currently hand
12c70 6c 65 64 20 22 29 0a 09 20 20 28 73 73 61 78 3a led ").. (ssax:
12c80 73 6b 69 70 2d 69 6e 74 65 72 6e 61 6c 2d 64 74 skip-internal-dt
12c90 64 20 70 6f 72 74 29 29 0a 09 28 73 73 61 78 3a d port))..(ssax:
12ca0 77 61 72 6e 20 70 6f 72 74 20 22 44 4f 43 54 59 warn port "DOCTY
12cb0 50 45 20 44 45 43 4c 20 22 20 64 6f 63 6e 61 6d PE DECL " docnam
12cc0 65 20 22 20 22 20 0a 09 20 20 73 79 73 74 65 6d e " " .. system
12cd0 69 64 20 22 20 66 6f 75 6e 64 20 61 6e 64 20 73 id " found and s
12ce0 6b 69 70 70 65 64 22 29 0a 09 28 76 61 6c 75 65 kipped")..(value
12cf0 73 20 23 66 20 27 28 29 20 27 28 29 20 73 65 65 s #f '() '() see
12d00 64 29 0a 09 29 29 0a 20 20 20 20 28 55 4e 44 45 d)..)). (UNDE
12d10 43 4c 2d 52 4f 4f 54 0a 20 20 20 20 20 20 28 6c CL-ROOT. (l
12d20 61 6d 62 64 61 20 28 65 6c 65 6d 2d 67 69 20 73 ambda (elem-gi s
12d30 65 65 64 29 20 28 76 61 6c 75 65 73 20 23 66 20 eed) (values #f
12d40 27 28 29 20 27 28 29 20 73 65 65 64 29 29 29 0a '() '() seed))).
12d50 20 20 20 20 28 44 45 43 4c 2d 52 4f 4f 54 0a 20 (DECL-ROOT.
12d60 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 65 6c (lambda (el
12d70 65 6d 2d 67 69 20 73 65 65 64 29 20 73 65 65 64 em-gi seed) seed
12d80 29 29 0a 20 20 20 20 28 4e 45 57 2d 4c 45 56 45 )). (NEW-LEVE
12d90 4c 2d 53 45 45 44 29 09 09 3b 20 72 65 71 75 69 L-SEED)..; requi
12da0 72 65 64 0a 20 20 20 20 28 46 49 4e 49 53 48 2d red. (FINISH-
12db0 45 4c 45 4d 45 4e 54 29 09 09 3b 20 72 65 71 75 ELEMENT)..; requ
12dc0 69 72 65 64 0a 20 20 20 20 28 43 48 41 52 2d 44 ired. (CHAR-D
12dd0 41 54 41 2d 48 41 4e 44 4c 45 52 29 09 09 3b 20 ATA-HANDLER)..;
12de0 72 65 71 75 69 72 65 64 0a 20 20 20 20 28 50 49 required. (PI
12df0 20 28 29 29 0a 20 20 20 20 29 29 0a 0a 0a 3b 3d ()). ))...;=
12e00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12e40 3d 3d 3d 3d 3d 3d 3d 0a 3b 09 09 48 69 67 68 65 =======.;..Highe
12e50 73 74 2d 6c 65 76 65 6c 20 70 61 72 73 65 72 73 st-level parsers
12e60 3a 20 58 4d 4c 20 74 6f 20 53 58 4d 4c 0a 3b 0a : XML to SXML.;.
12e70 0a 3b 20 46 69 72 73 74 2c 20 61 20 66 65 77 20 .; First, a few
12e80 75 74 69 6c 69 74 79 20 70 72 6f 63 65 64 75 72 utility procedur
12e90 65 73 20 74 68 61 74 20 74 75 72 6e 65 64 20 6f es that turned o
12ea0 75 74 20 75 73 65 66 75 6c 0a 0a 3b 20 20 20 20 ut useful..;
12eb0 20 73 73 61 78 3a 72 65 76 65 72 73 65 2d 63 6f ssax:reverse-co
12ec0 6c 6c 65 63 74 2d 73 74 72 20 4c 49 53 54 2d 4f llect-str LIST-O
12ed0 46 2d 46 52 41 47 53 20 2d 3e 20 4c 49 53 54 2d F-FRAGS -> LIST-
12ee0 4f 46 2d 46 52 41 47 53 0a 3b 20 67 69 76 65 6e OF-FRAGS.; given
12ef0 20 74 68 65 20 6c 69 73 74 20 6f 66 20 66 72 61 the list of fra
12f00 67 6d 65 6e 74 73 20 28 73 6f 6d 65 20 6f 66 20 gments (some of
12f10 77 68 69 63 68 20 61 72 65 20 74 65 78 74 20 73 which are text s
12f20 74 72 69 6e 67 73 29 0a 3b 20 72 65 76 65 72 73 trings).; revers
12f30 65 20 74 68 65 20 6c 69 73 74 20 61 6e 64 20 63 e the list and c
12f40 6f 6e 63 61 74 65 6e 61 74 65 20 61 64 6a 61 63 oncatenate adjac
12f50 65 6e 74 20 74 65 78 74 20 73 74 72 69 6e 67 73 ent text strings
12f60 2e 0a 3b 20 57 65 20 63 61 6e 20 70 72 6f 76 65 ..; We can prove
12f70 20 66 72 6f 6d 20 74 68 65 20 67 65 6e 65 72 61 from the genera
12f80 6c 20 63 61 73 65 20 62 65 6c 6f 77 20 74 68 61 l case below tha
12f90 74 20 69 66 20 4c 49 53 54 2d 4f 46 2d 46 52 41 t if LIST-OF-FRA
12fa0 47 53 0a 3b 20 68 61 73 20 7a 65 72 6f 20 6f 72 GS.; has zero or
12fb0 20 6f 6e 65 20 65 6c 65 6d 65 6e 74 2c 20 74 68 one element, th
12fc0 65 20 72 65 73 75 6c 74 20 6f 66 20 74 68 65 20 e result of the
12fd0 70 72 6f 63 65 64 75 72 65 20 69 73 20 65 71 75 procedure is equ
12fe0 61 6c 3f 0a 3b 20 74 6f 20 69 74 73 20 61 72 67 al?.; to its arg
12ff0 75 6d 65 6e 74 2e 20 54 68 69 73 20 66 61 63 74 ument. This fact
13000 20 6a 75 73 74 69 66 69 65 73 20 74 68 65 20 73 justifies the s
13010 68 6f 72 74 63 75 74 20 65 76 61 6c 75 61 74 69 hortcut evaluati
13020 6f 6e 20 62 65 6c 6f 77 2e 0a 28 64 65 66 69 6e on below..(defin
13030 65 20 28 73 73 61 78 3a 72 65 76 65 72 73 65 2d e (ssax:reverse-
13040 63 6f 6c 6c 65 63 74 2d 73 74 72 20 66 72 61 67 collect-str frag
13050 6d 65 6e 74 73 29 0a 20 20 28 63 6f 6e 64 0a 20 ments). (cond.
13060 20 20 20 28 28 6e 75 6c 6c 3f 20 66 72 61 67 6d ((null? fragm
13070 65 6e 74 73 29 20 27 28 29 29 09 3b 20 61 20 73 ents) '()).; a s
13080 68 6f 72 74 63 75 74 0a 20 20 20 20 28 28 6e 75 hortcut. ((nu
13090 6c 6c 3f 20 28 63 64 72 20 66 72 61 67 6d 65 6e ll? (cdr fragmen
130a0 74 73 29 29 20 66 72 61 67 6d 65 6e 74 73 29 20 ts)) fragments)
130b0 3b 20 73 65 65 20 74 68 65 20 63 6f 6d 6d 65 6e ; see the commen
130c0 74 20 61 62 6f 76 65 0a 20 20 20 20 28 65 6c 73 t above. (els
130d0 65 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f e. (let loo
130e0 70 20 28 28 66 72 61 67 6d 65 6e 74 73 20 66 72 p ((fragments fr
130f0 61 67 6d 65 6e 74 73 29 20 28 72 65 73 75 6c 74 agments) (result
13100 20 27 28 29 29 20 28 73 74 72 73 20 27 28 29 29 '()) (strs '())
13110 29 0a 09 28 63 6f 6e 64 0a 09 20 20 28 28 6e 75 )..(cond.. ((nu
13120 6c 6c 3f 20 66 72 61 67 6d 65 6e 74 73 29 0a 09 ll? fragments)..
13130 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 (if (null? s
13140 74 72 73 29 20 72 65 73 75 6c 74 0a 09 20 20 20 trs) result..
13150 20 20 20 28 63 6f 6e 73 20 28 73 74 72 69 6e 67 (cons (string
13160 2d 63 6f 6e 63 61 74 65 6e 61 74 65 2f 73 68 61 -concatenate/sha
13170 72 65 64 20 73 74 72 73 29 20 72 65 73 75 6c 74 red strs) result
13180 29 29 29 0a 09 20 20 28 28 73 74 72 69 6e 67 3f ))).. ((string?
13190 20 28 63 61 72 20 66 72 61 67 6d 65 6e 74 73 29 (car fragments)
131a0 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 64 ).. (loop (cd
131b0 72 20 66 72 61 67 6d 65 6e 74 73 29 20 72 65 73 r fragments) res
131c0 75 6c 74 20 28 63 6f 6e 73 20 28 63 61 72 20 66 ult (cons (car f
131d0 72 61 67 6d 65 6e 74 73 29 20 73 74 72 73 29 29 ragments) strs))
131e0 29 0a 09 20 20 28 65 6c 73 65 0a 09 20 20 20 20 ).. (else..
131f0 28 6c 6f 6f 70 20 28 63 64 72 20 66 72 61 67 6d (loop (cdr fragm
13200 65 6e 74 73 29 0a 09 20 20 20 20 20 20 28 63 6f ents).. (co
13210 6e 73 0a 09 09 28 63 61 72 20 66 72 61 67 6d 65 ns...(car fragme
13220 6e 74 73 29 0a 09 09 28 69 66 20 28 6e 75 6c 6c nts)...(if (null
13230 3f 20 73 74 72 73 29 20 72 65 73 75 6c 74 0a 09 ? strs) result..
13240 09 20 20 28 63 6f 6e 73 20 28 73 74 72 69 6e 67 . (cons (string
13250 2d 63 6f 6e 63 61 74 65 6e 61 74 65 2f 73 68 61 -concatenate/sha
13260 72 65 64 20 73 74 72 73 29 20 72 65 73 75 6c 74 red strs) result
13270 29 29 29 0a 09 20 20 20 20 20 20 27 28 29 29 29 ))).. '()))
13280 29 29 29 29 29 0a 0a 0a 3b 20 20 20 20 20 73 73 )))))...; ss
13290 61 78 3a 72 65 76 65 72 73 65 2d 63 6f 6c 6c 65 ax:reverse-colle
132a0 63 74 2d 73 74 72 2d 64 72 6f 70 2d 77 73 20 4c ct-str-drop-ws L
132b0 49 53 54 2d 4f 46 2d 46 52 41 47 53 20 2d 3e 20 IST-OF-FRAGS ->
132c0 4c 49 53 54 2d 4f 46 2d 46 52 41 47 53 0a 3b 20 LIST-OF-FRAGS.;
132d0 67 69 76 65 6e 20 74 68 65 20 6c 69 73 74 20 6f given the list o
132e0 66 20 66 72 61 67 6d 65 6e 74 73 20 28 73 6f 6d f fragments (som
132f0 65 20 6f 66 20 77 68 69 63 68 20 61 72 65 20 74 e of which are t
13300 65 78 74 20 73 74 72 69 6e 67 73 29 0a 3b 20 72 ext strings).; r
13310 65 76 65 72 73 65 20 74 68 65 20 6c 69 73 74 20 everse the list
13320 61 6e 64 20 63 6f 6e 63 61 74 65 6e 61 74 65 20 and concatenate
13330 61 64 6a 61 63 65 6e 74 20 74 65 78 74 20 73 74 adjacent text st
13340 72 69 6e 67 73 2e 0a 3b 20 57 65 20 61 6c 73 6f rings..; We also
13350 20 64 72 6f 70 20 22 75 6e 73 69 67 6e 69 66 69 drop "unsignifi
13360 63 61 6e 74 22 20 77 68 69 74 65 73 70 61 63 65 cant" whitespace
13370 2c 20 74 68 61 74 20 69 73 2c 20 77 68 69 74 65 , that is, white
13380 73 70 61 63 65 0a 3b 20 69 6e 20 66 72 6f 6e 74 space.; in front
13390 2c 20 62 65 68 69 6e 64 20 61 6e 64 20 62 65 74 , behind and bet
133a0 77 65 65 6e 20 65 6c 65 6d 65 6e 74 73 2e 20 54 ween elements. T
133b0 68 65 20 77 68 69 74 65 73 70 61 63 65 20 74 68 he whitespace th
133c0 61 74 0a 3b 20 69 73 20 69 6e 63 6c 75 64 65 64 at.; is included
133d0 20 69 6e 20 63 68 61 72 61 63 74 65 72 20 64 61 in character da
133e0 74 61 20 69 73 20 6e 6f 74 20 61 66 66 65 63 74 ta is not affect
133f0 65 64 2e 0a 3b 20 57 65 20 75 73 65 20 74 68 69 ed..; We use thi
13400 73 20 70 72 6f 63 65 64 75 72 65 20 74 6f 20 22 s procedure to "
13410 69 6e 74 65 6c 6c 69 67 65 6e 74 6c 79 22 20 64 intelligently" d
13420 72 6f 70 20 22 69 6e 73 69 67 6e 69 66 69 63 61 rop "insignifica
13430 6e 74 22 0a 3b 20 77 68 69 74 65 73 70 61 63 65 nt".; whitespace
13440 20 69 6e 20 74 68 65 20 70 61 72 73 65 64 20 53 in the parsed S
13450 58 4d 4c 2e 20 49 66 20 74 68 65 20 73 74 72 69 XML. If the stri
13460 63 74 20 63 6f 6d 70 6c 69 61 6e 63 65 20 77 69 ct compliance wi
13470 74 68 0a 3b 20 74 68 65 20 58 4d 4c 20 52 65 63 th.; the XML Rec
13480 6f 6d 6d 65 6e 64 61 74 69 6f 6e 20 72 65 67 61 ommendation rega
13490 72 64 69 6e 67 20 74 68 65 20 77 68 69 74 65 73 rding the whites
134a0 70 61 63 65 20 69 73 20 64 65 73 69 72 65 64 2c pace is desired,
134b0 20 70 6c 65 61 73 65 0a 3b 20 75 73 65 20 74 68 please.; use th
134c0 65 20 73 73 61 78 3a 72 65 76 65 72 73 65 2d 63 e ssax:reverse-c
134d0 6f 6c 6c 65 63 74 2d 73 74 72 20 70 72 6f 63 65 ollect-str proce
134e0 64 75 72 65 20 69 6e 73 74 65 61 64 2e 0a 0a 28 dure instead...(
134f0 64 65 66 69 6e 65 20 28 73 73 61 78 3a 72 65 76 define (ssax:rev
13500 65 72 73 65 2d 63 6f 6c 6c 65 63 74 2d 73 74 72 erse-collect-str
13510 2d 64 72 6f 70 2d 77 73 20 66 72 61 67 6d 65 6e -drop-ws fragmen
13520 74 73 29 0a 20 20 28 63 6f 6e 64 20 0a 20 20 20 ts). (cond .
13530 20 28 28 6e 75 6c 6c 3f 20 66 72 61 67 6d 65 6e ((null? fragmen
13540 74 73 29 20 27 28 29 29 09 09 3b 20 61 20 73 68 ts) '())..; a sh
13550 6f 72 74 63 75 74 0a 20 20 20 20 28 28 6e 75 6c ortcut. ((nul
13560 6c 3f 20 28 63 64 72 20 66 72 61 67 6d 65 6e 74 l? (cdr fragment
13570 73 29 29 09 09 3b 20 61 6e 6f 74 68 65 72 20 73 s))..; another s
13580 68 6f 72 74 63 75 74 0a 20 20 20 20 20 28 69 66 hortcut. (if
13590 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 28 (and (string? (
135a0 63 61 72 20 66 72 61 67 6d 65 6e 74 73 29 29 20 car fragments))
135b0 28 73 74 72 69 6e 67 2d 77 68 69 74 65 73 70 61 (string-whitespa
135c0 63 65 3f 20 28 63 61 72 20 66 72 61 67 6d 65 6e ce? (car fragmen
135d0 74 73 29 29 29 0a 20 20 20 20 20 20 20 27 28 29 ts))). '()
135e0 20 66 72 61 67 6d 65 6e 74 73 29 29 09 09 09 3b fragments))...;
135f0 20 72 65 6d 6f 76 65 20 74 72 61 69 6c 69 6e 67 remove trailing
13600 20 77 73 0a 20 20 20 20 28 65 6c 73 65 0a 20 20 ws. (else.
13610 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
13620 66 72 61 67 6d 65 6e 74 73 20 66 72 61 67 6d 65 fragments fragme
13630 6e 74 73 29 20 28 72 65 73 75 6c 74 20 27 28 29 nts) (result '()
13640 29 20 28 73 74 72 73 20 27 28 29 29 0a 09 09 20 ) (strs '())...
13650 20 28 61 6c 6c 2d 77 68 69 74 65 73 70 61 63 65 (all-whitespace
13660 3f 20 23 74 29 29 0a 09 28 63 6f 6e 64 0a 09 20 ? #t))..(cond..
13670 20 28 28 6e 75 6c 6c 3f 20 66 72 61 67 6d 65 6e ((null? fragmen
13680 74 73 29 0a 09 20 20 20 20 28 69 66 20 61 6c 6c ts).. (if all
13690 2d 77 68 69 74 65 73 70 61 63 65 3f 20 72 65 73 -whitespace? res
136a0 75 6c 74 09 3b 20 72 65 6d 6f 76 65 20 6c 65 61 ult.; remove lea
136b0 64 69 6e 67 20 77 73 0a 09 20 20 20 20 20 20 28 ding ws.. (
136c0 63 6f 6e 73 20 28 73 74 72 69 6e 67 2d 63 6f 6e cons (string-con
136d0 63 61 74 65 6e 61 74 65 2f 73 68 61 72 65 64 20 catenate/shared
136e0 73 74 72 73 29 20 72 65 73 75 6c 74 29 29 29 0a strs) result))).
136f0 09 20 20 28 28 73 74 72 69 6e 67 3f 20 28 63 61 . ((string? (ca
13700 72 20 66 72 61 67 6d 65 6e 74 73 29 29 0a 09 20 r fragments))..
13710 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 66 72 (loop (cdr fr
13720 61 67 6d 65 6e 74 73 29 20 72 65 73 75 6c 74 20 agments) result
13730 28 63 6f 6e 73 20 28 63 61 72 20 66 72 61 67 6d (cons (car fragm
13740 65 6e 74 73 29 20 73 74 72 73 29 0a 09 20 20 20 ents) strs)..
13750 20 20 20 28 61 6e 64 20 61 6c 6c 2d 77 68 69 74 (and all-whit
13760 65 73 70 61 63 65 3f 0a 09 09 28 73 74 72 69 6e espace?...(strin
13770 67 2d 77 68 69 74 65 73 70 61 63 65 3f 20 28 63 g-whitespace? (c
13780 61 72 20 66 72 61 67 6d 65 6e 74 73 29 29 29 29 ar fragments))))
13790 29 0a 09 20 20 28 65 6c 73 65 0a 09 20 20 20 20 ).. (else..
137a0 28 6c 6f 6f 70 20 28 63 64 72 20 66 72 61 67 6d (loop (cdr fragm
137b0 65 6e 74 73 29 0a 09 20 20 20 20 20 20 28 63 6f ents).. (co
137c0 6e 73 0a 09 09 28 63 61 72 20 66 72 61 67 6d 65 ns...(car fragme
137d0 6e 74 73 29 0a 09 09 28 69 66 20 61 6c 6c 2d 77 nts)...(if all-w
137e0 68 69 74 65 73 70 61 63 65 3f 20 72 65 73 75 6c hitespace? resul
137f0 74 0a 09 09 20 20 28 63 6f 6e 73 20 28 73 74 72 t... (cons (str
13800 69 6e 67 2d 63 6f 6e 63 61 74 65 6e 61 74 65 2f ing-concatenate/
13810 73 68 61 72 65 64 20 73 74 72 73 29 20 72 65 73 shared strs) res
13820 75 6c 74 29 29 29 0a 09 20 20 20 20 20 20 27 28 ult))).. '(
13830 29 20 23 74 29 29 29 29 29 29 29 0a 0a 0a 3b 20 ) #t)))))))...;
13840 70 72 6f 63 65 64 75 72 65 3a 20 73 73 61 78 3a procedure: ssax:
13850 78 6d 6c 2d 3e 73 78 6d 6c 20 50 4f 52 54 20 4e xml->sxml PORT N
13860 41 4d 45 53 50 41 43 45 2d 50 52 45 46 49 58 2d AMESPACE-PREFIX-
13870 41 53 53 49 47 0a 3b 0a 3b 20 54 68 69 73 20 69 ASSIG.;.; This i
13880 73 20 61 6e 20 69 6e 73 74 61 6e 63 65 20 6f 66 s an instance of
13890 20 61 20 53 53 41 58 20 70 61 72 73 65 72 20 61 a SSAX parser a
138a0 62 6f 76 65 20 74 68 61 74 20 72 65 74 75 72 6e bove that return
138b0 73 20 61 6e 20 53 58 4d 4c 0a 3b 20 72 65 70 72 s an SXML.; repr
138c0 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 74 68 esentation of th
138d0 65 20 58 4d 4c 20 64 6f 63 75 6d 65 6e 74 20 74 e XML document t
138e0 6f 20 62 65 20 72 65 61 64 20 66 72 6f 6d 20 50 o be read from P
138f0 4f 52 54 2e 0a 3b 20 4e 41 4d 45 53 50 41 43 45 ORT..; NAMESPACE
13900 2d 50 52 45 46 49 58 2d 41 53 53 49 47 20 69 73 -PREFIX-ASSIG is
13910 20 61 20 6c 69 73 74 20 6f 66 20 28 55 53 45 52 a list of (USER
13920 2d 50 52 45 46 49 58 20 2e 20 55 52 49 2d 53 54 -PREFIX . URI-ST
13930 52 49 4e 47 29 0a 3b 20 74 68 61 74 20 61 73 73 RING).; that ass
13940 69 67 6e 73 20 55 53 45 52 2d 50 52 45 46 49 58 igns USER-PREFIX
13950 65 73 20 74 6f 20 63 65 72 74 61 69 6e 20 6e 61 es to certain na
13960 6d 65 73 70 61 63 65 73 20 69 64 65 6e 74 69 66 mespaces identif
13970 69 65 64 20 62 79 0a 3b 20 70 61 72 74 69 63 75 ied by.; particu
13980 6c 61 72 20 55 52 49 2d 53 54 52 49 4e 47 73 2e lar URI-STRINGs.
13990 20 49 74 20 6d 61 79 20 62 65 20 61 6e 20 65 6d It may be an em
139a0 70 74 79 20 6c 69 73 74 2e 0a 3b 20 54 68 65 20 pty list..; The
139b0 70 72 6f 63 65 64 75 72 65 20 72 65 74 75 72 6e procedure return
139c0 73 20 61 6e 20 53 58 4d 4c 20 74 72 65 65 2e 20 s an SXML tree.
139d0 54 68 65 20 70 6f 72 74 20 70 6f 69 6e 74 73 20 The port points
139e0 6f 75 74 20 74 6f 20 74 68 65 0a 3b 20 66 69 72 out to the.; fir
139f0 73 74 20 63 68 61 72 61 63 74 65 72 20 61 66 74 st character aft
13a00 65 72 20 74 68 65 20 72 6f 6f 74 20 65 6c 65 6d er the root elem
13a10 65 6e 74 2e 0a 0a 28 64 65 66 69 6e 65 20 28 73 ent...(define (s
13a20 73 61 78 3a 78 6d 6c 2d 3e 73 78 6d 6c 20 70 6f sax:xml->sxml po
13a30 72 74 20 6e 61 6d 65 73 70 61 63 65 2d 70 72 65 rt namespace-pre
13a40 66 69 78 2d 61 73 73 69 67 29 0a 20 20 28 6c 65 fix-assig). (le
13a50 74 72 65 63 0a 20 20 20 20 20 20 28 28 6e 61 6d trec. ((nam
13a60 65 73 70 61 63 65 73 0a 09 28 6d 61 70 20 28 6c espaces..(map (l
13a70 61 6d 62 64 61 20 28 65 6c 29 0a 09 20 20 20 20 ambda (el)..
13a80 20 20 20 28 63 6f 6e 73 2a 20 23 66 20 28 63 61 (cons* #f (ca
13a90 72 20 65 6c 29 20 28 73 73 61 78 3a 75 72 69 2d r el) (ssax:uri-
13aa0 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 string->symbol (
13ab0 63 64 72 20 65 6c 29 29 29 29 0a 09 20 20 20 20 cdr el))))..
13ac0 20 6e 61 6d 65 73 70 61 63 65 2d 70 72 65 66 69 namespace-prefi
13ad0 78 2d 61 73 73 69 67 29 29 0a 0a 20 20 20 20 20 x-assig))..
13ae0 20 20 28 52 45 53 2d 4e 41 4d 45 2d 3e 53 58 4d (RES-NAME->SXM
13af0 4c 0a 09 28 6c 61 6d 62 64 61 20 28 72 65 73 2d L..(lambda (res-
13b00 6e 61 6d 65 29 0a 09 20 20 28 73 74 72 69 6e 67 name).. (string
13b10 2d 3e 73 79 6d 62 6f 6c 0a 09 20 20 20 28 73 74 ->symbol.. (st
13b20 72 69 6e 67 2d 61 70 70 65 6e 64 0a 09 20 20 20 ring-append..
13b30 20 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 (symbol->string
13b40 20 28 63 61 72 20 72 65 73 2d 6e 61 6d 65 29 29 (car res-name))
13b50 0a 09 20 20 20 20 22 3a 22 0a 09 20 20 20 20 28 .. ":".. (
13b60 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 28 symbol->string (
13b70 63 64 72 20 72 65 73 2d 6e 61 6d 65 29 29 29 29 cdr res-name))))
13b80 29 29 0a 0a 20 20 20 20 20 20 20 29 0a 20 20 20 )).. ).
13b90 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 0a 09 (let ((result..
13ba0 20 20 20 28 72 65 76 65 72 73 65 0a 09 20 20 20 (reverse..
13bb0 20 28 28 73 73 61 78 3a 6d 61 6b 65 2d 70 61 72 ((ssax:make-par
13bc0 73 65 72 0a 09 20 20 20 20 20 4e 45 57 2d 4c 45 ser.. NEW-LE
13bd0 56 45 4c 2d 53 45 45 44 20 0a 09 20 20 20 20 20 VEL-SEED ..
13be0 28 6c 61 6d 62 64 61 20 28 65 6c 65 6d 2d 67 69 (lambda (elem-gi
13bf0 20 61 74 74 72 69 62 75 74 65 73 20 6e 61 6d 65 attributes name
13c00 73 70 61 63 65 73 0a 09 09 09 20 20 20 20 20 20 spaces....
13c10 65 78 70 65 63 74 65 64 2d 63 6f 6e 74 65 6e 74 expected-content
13c20 20 73 65 65 64 29 0a 09 20 20 20 20 20 20 20 27 seed).. '
13c30 28 29 29 0a 20 20 20 0a 09 20 20 20 20 20 46 49 ()). .. FI
13c40 4e 49 53 48 2d 45 4c 45 4d 45 4e 54 0a 09 20 20 NISH-ELEMENT..
13c50 20 20 20 28 6c 61 6d 62 64 61 20 28 65 6c 65 6d (lambda (elem
13c60 2d 67 69 20 61 74 74 72 69 62 75 74 65 73 20 6e -gi attributes n
13c70 61 6d 65 73 70 61 63 65 73 20 70 61 72 65 6e 74 amespaces parent
13c80 2d 73 65 65 64 20 73 65 65 64 29 0a 09 20 20 20 -seed seed)..
13c90 20 20 20 20 28 6c 65 74 20 28 28 73 65 65 64 20 (let ((seed
13ca0 28 73 73 61 78 3a 72 65 76 65 72 73 65 2d 63 6f (ssax:reverse-co
13cb0 6c 6c 65 63 74 2d 73 74 72 2d 64 72 6f 70 2d 77 llect-str-drop-w
13cc0 73 20 73 65 65 64 29 29 0a 09 09 20 20 20 20 20 s seed))...
13cd0 28 61 74 74 72 73 0a 09 09 20 20 20 20 20 20 28 (attrs... (
13ce0 61 74 74 6c 69 73 74 2d 66 6f 6c 64 0a 09 09 20 attlist-fold...
13cf0 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 (lambda (a
13d00 74 74 72 20 61 63 63 75 6d 29 0a 09 09 09 20 28 ttr accum).... (
13d10 63 6f 6e 73 20 28 6c 69 73 74 20 0a 09 09 09 09 cons (list .....
13d20 28 69 66 20 28 73 79 6d 62 6f 6c 3f 20 28 63 61 (if (symbol? (ca
13d30 72 20 61 74 74 72 29 29 20 28 63 61 72 20 61 74 r attr)) (car at
13d40 74 72 29 0a 09 09 09 09 20 20 20 20 28 52 45 53 tr)..... (RES
13d50 2d 4e 41 4d 45 2d 3e 53 58 4d 4c 20 28 63 61 72 -NAME->SXML (car
13d60 20 61 74 74 72 29 29 29 0a 09 09 09 09 28 63 64 attr))).....(cd
13d70 72 20 61 74 74 72 29 29 20 61 63 63 75 6d 29 29 r attr)) accum))
13d80 0a 09 09 20 20 20 20 20 20 20 27 28 29 20 61 74 ... '() at
13d90 74 72 69 62 75 74 65 73 29 29 29 0a 09 09 20 28 tributes)))... (
13da0 63 6f 6e 73 0a 09 09 20 20 28 63 6f 6e 73 20 0a cons... (cons .
13db0 09 09 20 20 20 28 69 66 20 28 73 79 6d 62 6f 6c .. (if (symbol
13dc0 3f 20 65 6c 65 6d 2d 67 69 29 20 65 6c 65 6d 2d ? elem-gi) elem-
13dd0 67 69 0a 09 09 20 20 20 20 20 20 20 28 52 45 53 gi... (RES
13de0 2d 4e 41 4d 45 2d 3e 53 58 4d 4c 20 65 6c 65 6d -NAME->SXML elem
13df0 2d 67 69 29 29 0a 09 09 20 20 20 28 69 66 20 28 -gi))... (if (
13e00 6e 75 6c 6c 3f 20 61 74 74 72 73 29 20 73 65 65 null? attrs) see
13e10 64 0a 09 09 20 20 20 20 20 20 20 28 63 6f 6e 73 d... (cons
13e20 20 28 63 6f 6e 73 20 27 40 20 61 74 74 72 73 29 (cons '@ attrs)
13e30 20 73 65 65 64 29 29 29 0a 09 09 20 20 70 61 72 seed)))... par
13e40 65 6e 74 2d 73 65 65 64 29 29 29 0a 0a 09 20 20 ent-seed)))...
13e50 20 20 20 43 48 41 52 2d 44 41 54 41 2d 48 41 4e CHAR-DATA-HAN
13e60 44 4c 45 52 0a 09 20 20 20 20 20 28 6c 61 6d 62 DLER.. (lamb
13e70 64 61 20 28 73 74 72 69 6e 67 31 20 73 74 72 69 da (string1 stri
13e80 6e 67 32 20 73 65 65 64 29 0a 09 20 20 20 20 20 ng2 seed)..
13e90 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d 6e 75 (if (string-nu
13ea0 6c 6c 3f 20 73 74 72 69 6e 67 32 29 20 28 63 6f ll? string2) (co
13eb0 6e 73 20 73 74 72 69 6e 67 31 20 73 65 65 64 29 ns string1 seed)
13ec0 0a 09 09 20 20 20 28 63 6f 6e 73 2a 20 73 74 72 ... (cons* str
13ed0 69 6e 67 32 20 73 74 72 69 6e 67 31 20 73 65 65 ing2 string1 see
13ee0 64 29 29 29 0a 0a 09 20 20 20 20 20 44 4f 43 54 d)))... DOCT
13ef0 59 50 45 0a 09 20 20 20 20 20 28 6c 61 6d 62 64 YPE.. (lambd
13f00 61 20 28 70 6f 72 74 20 64 6f 63 6e 61 6d 65 20 a (port docname
13f10 73 79 73 74 65 6d 69 64 20 69 6e 74 65 72 6e 61 systemid interna
13f20 6c 2d 73 75 62 73 65 74 3f 20 73 65 65 64 29 0a l-subset? seed).
13f30 09 20 20 20 20 20 20 20 28 77 68 65 6e 20 69 6e . (when in
13f40 74 65 72 6e 61 6c 2d 73 75 62 73 65 74 3f 0a 09 ternal-subset?..
13f50 09 20 20 20 20 20 28 73 73 61 78 3a 77 61 72 6e . (ssax:warn
13f60 20 70 6f 72 74 0a 09 09 09 20 20 20 22 49 6e 74 port.... "Int
13f70 65 72 6e 61 6c 20 44 54 44 20 73 75 62 73 65 74 ernal DTD subset
13f80 20 69 73 20 6e 6f 74 20 63 75 72 72 65 6e 74 6c is not currentl
13f90 79 20 68 61 6e 64 6c 65 64 20 22 29 0a 09 09 20 y handled ")...
13fa0 20 20 20 20 28 73 73 61 78 3a 73 6b 69 70 2d 69 (ssax:skip-i
13fb0 6e 74 65 72 6e 61 6c 2d 64 74 64 20 70 6f 72 74 nternal-dtd port
13fc0 29 29 0a 09 20 20 20 20 20 20 20 28 73 73 61 78 )).. (ssax
13fd0 3a 77 61 72 6e 20 70 6f 72 74 20 22 44 4f 43 54 :warn port "DOCT
13fe0 59 50 45 20 44 45 43 4c 20 22 20 64 6f 63 6e 61 YPE DECL " docna
13ff0 6d 65 20 22 20 22 0a 09 09 20 20 20 20 20 73 79 me " "... sy
14000 73 74 65 6d 69 64 20 22 20 66 6f 75 6e 64 20 61 stemid " found a
14010 6e 64 20 73 6b 69 70 70 65 64 22 29 0a 09 20 20 nd skipped")..
14020 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 66 20 (values #f
14030 27 28 29 20 6e 61 6d 65 73 70 61 63 65 73 20 73 '() namespaces s
14040 65 65 64 29 29 0a 0a 09 20 20 20 20 20 55 4e 44 eed))... UND
14050 45 43 4c 2d 52 4f 4f 54 0a 09 20 20 20 20 20 28 ECL-ROOT.. (
14060 6c 61 6d 62 64 61 20 28 65 6c 65 6d 2d 67 69 20 lambda (elem-gi
14070 73 65 65 64 29 0a 09 20 20 20 20 20 20 20 28 76 seed).. (v
14080 61 6c 75 65 73 20 23 66 20 27 28 29 20 6e 61 6d alues #f '() nam
14090 65 73 70 61 63 65 73 20 73 65 65 64 29 29 0a 0a espaces seed))..
140a0 09 20 20 20 20 20 50 49 0a 09 20 20 20 20 20 28 . PI.. (
140b0 28 2a 44 45 46 41 55 4c 54 2a 20 2e 0a 09 09 28 (*DEFAULT* ....(
140c0 6c 61 6d 62 64 61 20 28 70 6f 72 74 20 70 69 2d lambda (port pi-
140d0 74 61 67 20 73 65 65 64 29 0a 09 09 20 20 28 63 tag seed)... (c
140e0 6f 6e 73 0a 09 09 20 20 20 28 6c 69 73 74 20 27 ons... (list '
140f0 2a 50 49 2a 20 70 69 2d 74 61 67 20 28 73 73 61 *PI* pi-tag (ssa
14100 78 3a 72 65 61 64 2d 70 69 2d 62 6f 64 79 2d 61 x:read-pi-body-a
14110 73 2d 73 74 72 69 6e 67 20 70 6f 72 74 29 29 0a s-string port)).
14120 09 09 20 20 20 73 65 65 64 29 29 29 29 0a 09 20 .. seed))))..
14130 20 20 20 20 29 0a 09 20 20 20 20 70 6f 72 74 20 ).. port
14140 27 28 29 29 29 29 29 0a 20 20 20 20 20 20 28 63 '())))). (c
14150 6f 6e 73 20 27 2a 54 4f 50 2a 0a 09 20 20 20 20 ons '*TOP*..
14160 28 69 66 20 28 6e 75 6c 6c 3f 20 6e 61 6d 65 73 (if (null? names
14170 70 61 63 65 2d 70 72 65 66 69 78 2d 61 73 73 69 pace-prefix-assi
14180 67 29 20 72 65 73 75 6c 74 0a 09 09 28 63 6f 6e g) result...(con
14190 73 0a 09 09 20 28 6c 69 73 74 20 27 40 20 28 63 s... (list '@ (c
141a0 6f 6e 73 20 27 2a 4e 41 4d 45 53 50 41 43 45 53 ons '*NAMESPACES
141b0 2a 20 0a 09 09 09 09 20 28 6d 61 70 20 28 6c 61 * ..... (map (la
141c0 6d 62 64 61 20 28 6e 73 29 20 28 6c 69 73 74 20 mbda (ns) (list
141d0 28 63 61 72 20 6e 73 29 20 28 63 64 72 20 6e 73 (car ns) (cdr ns
141e0 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 6e 61 )))..... na
141f0 6d 65 73 70 61 63 65 2d 70 72 65 66 69 78 2d 61 mespace-prefix-a
14200 73 73 69 67 29 29 29 0a 09 09 20 20 20 20 20 20 ssig)))...
14210 72 65 73 75 6c 74 29 29 29 0a 29 29 29 0a result))).))).