Artifact
41f07430efe4dd274cebadbadfa582e676e80dcd:
0000: 23 21 72 36 72 73 0a 3b 3b 3b 20 46 49 4c 45 20 #!r6rs.;;; FILE
0010: 20 20 20 20 20 20 22 69 6e 74 65 72 6d 65 64 69 "intermedi
0020: 61 74 65 2d 66 6f 72 6d 61 74 2d 73 74 72 69 6e ate-format-strin
0030: 67 73 2e 73 6c 73 22 0a 3b 3b 3b 20 49 4d 50 4c gs.sls".;;; IMPL
0040: 45 4d 45 4e 54 53 20 53 52 46 49 2d 34 38 3a 20 EMENTS SRFI-48:
0050: 49 6e 74 65 72 6d 65 64 69 61 72 79 20 66 6f 72 Intermediary for
0060: 6d 61 74 20 73 74 72 69 6e 67 73 0a 3b 3b 3b 20 mat strings.;;;
0070: 20 20 20 20 20 20 20 20 20 20 20 68 74 74 70 3a http:
0080: 2f 2f 73 72 66 69 2e 73 63 68 65 6d 65 72 73 2e //srfi.schemers.
0090: 6f 72 67 2f 73 72 66 69 2d 34 38 2f 73 72 66 69 org/srfi-48/srfi
00a0: 2d 34 38 2e 68 74 6d 6c 0a 3b 3b 3b 20 41 55 54 -48.html.;;; AUT
00b0: 48 4f 52 20 20 20 20 20 4b 65 6e 20 44 69 63 6b HOR Ken Dick
00c0: 65 79 0a 3b 3b 3b 20 55 50 44 41 54 45 44 20 20 ey.;;; UPDATED
00d0: 20 20 53 79 6e 74 61 78 20 75 70 64 61 74 65 64 Syntax updated
00e0: 20 66 6f 72 20 52 36 52 53 20 46 65 62 72 75 61 for R6RS Februa
00f0: 72 79 20 32 30 30 38 20 62 79 20 4b 65 6e 20 44 ry 2008 by Ken D
0100: 69 63 6b 65 79 0a 3b 3b 3b 20 4c 41 4e 47 55 41 ickey.;;; LANGUA
0110: 47 45 20 20 20 52 36 52 53 20 62 75 74 20 73 70 GE R6RS but sp
0120: 65 63 69 66 69 63 20 74 6f 20 49 6b 61 72 75 73 ecific to Ikarus
0130: 20 53 63 68 65 6d 65 0a 0a 3b 3b 20 53 6d 61 6c Scheme..;; Smal
0140: 6c 20 63 68 61 6e 67 65 73 20 62 79 20 44 65 72 l changes by Der
0150: 69 63 6b 20 45 64 64 69 6e 67 74 6f 6e 20 74 6f ick Eddington to
0160: 20 6d 61 6b 65 20 74 68 65 20 62 65 67 69 6e 69 make the begini
0170: 6e 67 20 6f 66 20 60 66 6f 72 6d 61 74 27 0a 3b ng of `format'.;
0180: 3b 20 6d 6f 72 65 20 65 66 66 65 63 69 65 6e 74 ; more effecient
0190: 20 61 6e 64 20 6d 6f 72 65 20 61 62 73 74 72 61 and more abstra
01a0: 63 74 65 64 2e 20 0a 0a 3b 3b 3b 43 6f 70 79 72 cted. ..;;;Copyr
01b0: 69 67 68 74 20 28 43 29 20 4b 65 6e 6e 65 74 68 ight (C) Kenneth
01c0: 20 41 20 44 69 63 6b 65 79 20 28 32 30 30 33 29 A Dickey (2003)
01d0: 2e 20 41 6c 6c 20 52 69 67 68 74 73 20 52 65 73 . All Rights Res
01e0: 65 72 76 65 64 2e 0a 3b 3b 3b 0a 3b 3b 3b 50 65 erved..;;;.;;;Pe
01f0: 72 6d 69 73 73 69 6f 6e 20 69 73 20 68 65 72 65 rmission is here
0200: 62 79 20 67 72 61 6e 74 65 64 2c 20 66 72 65 65 by granted, free
0210: 20 6f 66 20 63 68 61 72 67 65 2c 20 74 6f 20 61 of charge, to a
0220: 6e 79 20 70 65 72 73 6f 6e 0a 3b 3b 3b 6f 62 74 ny person.;;;obt
0230: 61 69 6e 69 6e 67 20 61 20 63 6f 70 79 20 6f 66 aining a copy of
0240: 20 74 68 69 73 20 73 6f 66 74 77 61 72 65 20 61 this software a
0250: 6e 64 20 61 73 73 6f 63 69 61 74 65 64 20 64 6f nd associated do
0260: 63 75 6d 65 6e 74 61 74 69 6f 6e 0a 3b 3b 3b 66 cumentation.;;;f
0270: 69 6c 65 73 20 28 74 68 65 20 22 53 6f 66 74 77 iles (the "Softw
0280: 61 72 65 22 29 2c 20 74 6f 20 64 65 61 6c 20 69 are"), to deal i
0290: 6e 20 74 68 65 20 53 6f 66 74 77 61 72 65 20 77 n the Software w
02a0: 69 74 68 6f 75 74 0a 3b 3b 3b 72 65 73 74 72 69 ithout.;;;restri
02b0: 63 74 69 6f 6e 2c 20 69 6e 63 6c 75 64 69 6e 67 ction, including
02c0: 20 77 69 74 68 6f 75 74 20 6c 69 6d 69 74 61 74 without limitat
02d0: 69 6f 6e 20 74 68 65 20 72 69 67 68 74 73 20 74 ion the rights t
02e0: 6f 20 75 73 65 2c 0a 3b 3b 3b 63 6f 70 79 2c 20 o use,.;;;copy,
02f0: 6d 6f 64 69 66 79 2c 20 6d 65 72 67 65 2c 20 70 modify, merge, p
0300: 75 62 6c 69 73 68 2c 20 64 69 73 74 72 69 62 75 ublish, distribu
0310: 74 65 2c 20 73 75 62 6c 69 63 65 6e 73 65 2c 20 te, sublicense,
0320: 61 6e 64 2f 6f 72 0a 3b 3b 3b 73 65 6c 6c 20 63 and/or.;;;sell c
0330: 6f 70 69 65 73 20 6f 66 20 74 68 65 20 53 6f 66 opies of the Sof
0340: 74 77 61 72 65 2c 20 61 6e 64 20 74 6f 20 70 65 tware, and to pe
0350: 72 6d 69 74 20 70 65 72 73 6f 6e 73 20 74 6f 20 rmit persons to
0360: 77 68 6f 6d 0a 3b 3b 3b 74 68 65 20 53 6f 66 74 whom.;;;the Soft
0370: 77 61 72 65 20 69 73 20 66 75 72 6e 69 73 68 65 ware is furnishe
0380: 64 20 74 6f 20 64 6f 20 73 6f 2c 20 73 75 62 6a d to do so, subj
0390: 65 63 74 20 74 6f 20 74 68 65 20 66 6f 6c 6c 6f ect to the follo
03a0: 77 69 6e 67 0a 3b 3b 3b 63 6f 6e 64 69 74 69 6f wing.;;;conditio
03b0: 6e 73 3a 0a 3b 3b 3b 0a 3b 3b 3b 54 68 65 20 61 ns:.;;;.;;;The a
03c0: 62 6f 76 65 20 63 6f 70 79 72 69 67 68 74 20 6e bove copyright n
03d0: 6f 74 69 63 65 20 61 6e 64 20 74 68 69 73 20 70 otice and this p
03e0: 65 72 6d 69 73 73 69 6f 6e 20 6e 6f 74 69 63 65 ermission notice
03f0: 20 73 68 61 6c 6c 0a 3b 3b 3b 62 65 20 69 6e 63 shall.;;;be inc
0400: 6c 75 64 65 64 20 69 6e 20 61 6c 6c 20 63 6f 70 luded in all cop
0410: 69 65 73 20 6f 72 20 73 75 62 73 74 61 6e 74 69 ies or substanti
0420: 61 6c 20 70 6f 72 74 69 6f 6e 73 20 6f 66 20 74 al portions of t
0430: 68 65 20 53 6f 66 74 77 61 72 65 2e 0a 3b 3b 3b he Software..;;;
0440: 0a 3b 3b 3b 54 48 45 20 53 4f 46 54 57 41 52 45 .;;;THE SOFTWARE
0450: 20 49 53 20 50 52 4f 56 49 44 45 44 20 22 41 53 IS PROVIDED "AS
0460: 20 49 53 22 2c 20 57 49 54 48 4f 55 54 20 57 41 IS", WITHOUT WA
0470: 52 52 41 4e 54 59 20 4f 46 20 41 4e 59 20 4b 49 RRANTY OF ANY KI
0480: 4e 44 2c 0a 3b 3b 3b 45 58 50 52 45 53 53 20 4f ND,.;;;EXPRESS O
0490: 52 20 49 4d 50 4c 49 45 44 2c 20 49 4e 43 4c 55 R IMPLIED, INCLU
04a0: 44 49 4e 47 20 42 55 54 20 4e 4f 54 20 4c 49 4d DING BUT NOT LIM
04b0: 49 54 45 44 20 54 4f 20 54 48 45 20 57 41 52 52 ITED TO THE WARR
04c0: 41 4e 54 49 45 53 0a 3b 3b 3b 4f 46 20 4d 45 52 ANTIES.;;;OF MER
04d0: 43 48 41 4e 54 41 42 49 4c 49 54 59 2c 20 46 49 CHANTABILITY, FI
04e0: 54 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 TNESS FOR A PART
04f0: 49 43 55 4c 41 52 20 50 55 52 50 4f 53 45 20 41 ICULAR PURPOSE A
0500: 4e 44 0a 3b 3b 3b 4e 4f 4e 49 4e 46 52 49 4e 47 ND.;;;NONINFRING
0510: 45 4d 45 4e 54 2e 20 49 4e 20 4e 4f 20 45 56 45 EMENT. IN NO EVE
0520: 4e 54 20 53 48 41 4c 4c 20 54 48 45 20 41 55 54 NT SHALL THE AUT
0530: 48 4f 52 53 20 4f 52 20 43 4f 50 59 52 49 47 48 HORS OR COPYRIGH
0540: 54 0a 3b 3b 3b 48 4f 4c 44 45 52 53 20 42 45 20 T.;;;HOLDERS BE
0550: 4c 49 41 42 4c 45 20 46 4f 52 20 41 4e 59 20 43 LIABLE FOR ANY C
0560: 4c 41 49 4d 2c 20 44 41 4d 41 47 45 53 20 4f 52 LAIM, DAMAGES OR
0570: 20 4f 54 48 45 52 20 4c 49 41 42 49 4c 49 54 59 OTHER LIABILITY
0580: 2c 0a 3b 3b 3b 57 48 45 54 48 45 52 20 49 4e 20 ,.;;;WHETHER IN
0590: 41 4e 20 41 43 54 49 4f 4e 20 4f 46 20 43 4f 4e AN ACTION OF CON
05a0: 54 52 41 43 54 2c 20 54 4f 52 54 20 4f 52 20 4f TRACT, TORT OR O
05b0: 54 48 45 52 57 49 53 45 2c 20 41 52 49 53 49 4e THERWISE, ARISIN
05c0: 47 0a 3b 3b 3b 46 52 4f 4d 2c 20 4f 55 54 20 4f G.;;;FROM, OUT O
05d0: 46 20 4f 52 20 49 4e 20 43 4f 4e 4e 45 43 54 49 F OR IN CONNECTI
05e0: 4f 4e 20 57 49 54 48 20 54 48 45 20 53 4f 46 54 ON WITH THE SOFT
05f0: 57 41 52 45 20 4f 52 20 54 48 45 20 55 53 45 20 WARE OR THE USE
0600: 4f 52 0a 3b 3b 3b 4f 54 48 45 52 20 44 45 41 4c OR.;;;OTHER DEAL
0610: 49 4e 47 53 20 49 4e 20 54 48 45 20 53 4f 46 54 INGS IN THE SOFT
0620: 57 41 52 45 2e 0a 0a 3b 20 54 68 65 20 69 6d 70 WARE...; The imp
0630: 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 62 65 6c 6f lementation belo
0640: 77 20 72 65 71 75 69 72 65 73 20 53 52 46 49 2d w requires SRFI-
0650: 36 20 28 42 61 73 69 63 20 73 74 72 69 6e 67 20 6 (Basic string
0660: 70 6f 72 74 73 29 2c 20 0a 3b 20 61 6e 64 20 53 ports), .; and S
0670: 52 46 49 2d 33 38 20 28 45 78 74 65 72 6e 61 6c RFI-38 (External
0680: 20 52 65 70 72 65 73 65 6e 74 61 74 69 6f 6e 20 Representation
0690: 66 6f 72 20 44 61 74 61 20 57 69 74 68 20 53 68 for Data With Sh
06a0: 61 72 65 64 20 53 74 72 75 63 74 75 72 65 29 2e ared Structure).
06b0: 20 0a 20 0a 28 6c 69 62 72 61 72 79 20 28 73 72 . .(library (sr
06c0: 66 69 20 73 34 38 20 69 6e 74 65 72 6d 65 64 69 fi s48 intermedi
06d0: 61 74 65 2d 66 6f 72 6d 61 74 2d 73 74 72 69 6e ate-format-strin
06e0: 67 73 29 0a 20 20 28 65 78 70 6f 72 74 20 0a 20 gs). (export .
06f0: 20 20 20 66 6f 72 6d 61 74 29 0a 20 20 28 69 6d format). (im
0700: 70 6f 72 74 0a 20 20 20 20 28 72 6e 72 73 29 0a port. (rnrs).
0710: 20 20 20 20 28 73 72 66 69 20 73 34 38 20 69 6e (srfi s48 in
0720: 74 65 72 6d 65 64 69 61 74 65 2d 66 6f 72 6d 61 termediate-forma
0730: 74 2d 73 74 72 69 6e 67 73 20 63 6f 6d 70 61 74 t-strings compat
0740: 29 0a 20 20 20 20 28 73 72 66 69 20 73 36 20 20 ). (srfi s6
0750: 62 61 73 69 63 2d 73 74 72 69 6e 67 2d 70 6f 72 basic-string-por
0760: 74 73 29 0a 20 20 20 20 28 73 72 66 69 20 73 33 ts). (srfi s3
0770: 38 20 77 69 74 68 2d 73 68 61 72 65 64 2d 73 74 8 with-shared-st
0780: 72 75 63 74 75 72 65 29 29 0a 20 20 0a 20 20 28 ructure)). . (
0790: 64 65 66 69 6e 65 20 61 73 63 69 69 2d 74 61 62 define ascii-tab
07a0: 20 23 5c 74 61 62 29 0a 20 20 20 20 0a 20 20 28 #\tab). . (
07b0: 64 65 66 69 6e 65 20 28 66 6f 72 6d 61 74 20 61 define (format a
07c0: 72 67 30 20 2e 20 61 72 67 2a 29 0a 20 20 20 20 rg0 . arg*).
07d0: 0a 20 20 20 20 28 64 65 66 69 6e 65 20 28 70 72 . (define (pr
07e0: 6f 62 6c 65 6d 20 6d 73 67 20 2e 20 69 72 74 73 oblem msg . irts
07f0: 29 0a 20 20 20 20 20 20 28 61 70 70 6c 79 20 61 ). (apply a
0800: 73 73 65 72 74 69 6f 6e 2d 76 69 6f 6c 61 74 69 ssertion-violati
0810: 6f 6e 20 27 66 6f 72 6d 61 74 20 6d 73 67 20 69 on 'format msg i
0820: 72 74 73 29 29 0a 20 20 20 20 0a 20 20 20 20 28 rts)). . (
0830: 64 65 66 69 6e 65 20 28 5f 66 6f 72 6d 61 74 20 define (_format
0840: 70 6f 72 74 20 66 6f 72 6d 61 74 2d 73 74 72 69 port format-stri
0850: 6e 67 20 61 72 67 73 20 72 65 74 75 72 6e 2d 76 ng args return-v
0860: 61 6c 75 65 29 20 20 20 20 20 20 0a 0a 20 20 20 alue) ..
0870: 20 20 20 28 64 65 66 69 6e 65 20 28 73 74 72 69 (define (stri
0880: 6e 67 2d 69 6e 64 65 78 20 73 74 72 20 63 29 0a ng-index str c).
0890: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 20 5b (let ( [
08a0: 6c 65 6e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 len (string-leng
08b0: 74 68 20 73 74 72 29 5d 20 29 0a 20 20 20 20 20 th str)] ).
08c0: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 (let loop (
08d0: 20 5b 69 20 30 5d 20 29 0a 20 20 20 20 20 20 20 [i 0] ).
08e0: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 3d 20 69 (cond ((= i
08f0: 20 6c 65 6e 29 20 23 66 29 0a 20 20 20 20 20 20 len) #f).
0900: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 65 71 ((eq
0910: 76 3f 20 63 20 28 73 74 72 69 6e 67 2d 72 65 66 v? c (string-ref
0920: 20 73 74 72 20 69 29 29 20 69 29 0a 20 20 20 20 str i)) i).
0930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
0940: 6c 73 65 20 28 6c 6f 6f 70 20 28 2b 20 69 20 31 lse (loop (+ i 1
0950: 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 0a 20 ))))))). .
0960: 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 73 74 (define (st
0970: 72 69 6e 67 2d 67 72 6f 77 20 73 74 72 20 6c 65 ring-grow str le
0980: 6e 20 63 68 61 72 29 0a 20 20 20 20 20 20 20 20 n char).
0990: 28 6c 65 74 20 28 20 5b 6f 66 66 20 28 2d 20 6c (let ( [off (- l
09a0: 65 6e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 en (string-lengt
09b0: 68 20 73 74 72 29 29 5d 20 29 0a 20 20 20 20 20 h str))] ).
09c0: 20 20 20 20 20 28 69 66 20 28 70 6f 73 69 74 69 (if (positi
09d0: 76 65 3f 20 6f 66 66 29 0a 20 20 20 20 20 20 20 ve? off).
09e0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 (string-app
09f0: 65 6e 64 20 28 6d 61 6b 65 2d 73 74 72 69 6e 67 end (make-string
0a00: 20 6f 66 66 20 63 68 61 72 29 20 73 74 72 29 0a off char) str).
0a10: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 72 29 str)
0a20: 29 29 0a 20 20 20 20 20 20 0a 28 64 65 66 69 6e )). .(defin
0a30: 65 20 28 63 6f 6d 70 6f 73 65 2d 77 69 74 68 2d e (compose-with-
0a40: 64 69 67 69 74 73 20 64 69 67 69 74 73 20 70 72 digits digits pr
0a50: 65 2d 73 74 72 20 66 72 61 63 2d 73 74 72 20 65 e-str frac-str e
0a60: 78 70 2d 73 74 72 29 0a 20 20 20 20 20 20 20 20 xp-str).
0a70: 28 6c 65 74 20 28 20 5b 66 72 61 63 2d 6c 65 6e (let ( [frac-len
0a80: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
0a90: 66 72 61 63 2d 73 74 72 29 5d 20 29 0a 3b 3b 40 frac-str)] ).;;@
0aa0: 40 44 45 42 55 47 0a 3b 3b 28 66 6f 72 6d 61 74 @DEBUG.;;(format
0ab0: 20 23 74 20 22 7e 25 40 40 28 63 6f 6d 70 6f 73 #t "~%@@(compos
0ac0: 65 2d 77 69 74 68 2d 64 69 67 69 74 73 20 64 69 e-with-digits di
0ad0: 67 69 74 73 3d 7e 73 20 70 72 65 2d 73 74 72 3d gits=~s pre-str=
0ae0: 7e 73 20 66 72 61 63 2d 73 74 72 3d 7e 73 20 65 ~s frac-str=~s e
0af0: 78 70 2d 73 74 72 3d 7e 73 20 29 20 7e 25 22 20 xp-str=~s ) ~%"
0b00: 64 69 67 69 74 73 20 70 72 65 2d 73 74 72 20 66 digits pre-str f
0b10: 72 61 63 2d 73 74 72 20 65 78 70 2d 73 74 72 29 rac-str exp-str)
0b20: 0a 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 . (cond
0b30: 09 0a 20 20 20 20 20 20 20 20 20 20 20 20 5b 28 .. [(
0b40: 3c 20 66 72 61 63 2d 6c 65 6e 20 64 69 67 69 74 < frac-len digit
0b50: 73 29 20 3b 3b 20 67 72 6f 77 20 66 72 61 63 20 s) ;; grow frac
0b60: 70 61 72 74 2c 20 70 61 64 20 77 69 74 68 20 7a part, pad with z
0b70: 65 72 6f 73 0a 20 20 20 20 20 20 20 20 20 20 20 eros.
0b80: 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 (string-append
0b90: 20 70 72 65 2d 73 74 72 20 22 2e 22 0a 20 20 20 pre-str ".".
0ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bb0: 20 20 20 20 20 20 20 20 20 66 72 61 63 2d 73 74 frac-st
0bc0: 72 20 28 6d 61 6b 65 2d 73 74 72 69 6e 67 20 28 r (make-string (
0bd0: 2d 20 64 69 67 69 74 73 20 66 72 61 63 2d 6c 65 - digits frac-le
0be0: 6e 29 20 23 5c 30 29 0a 20 20 20 20 20 20 20 20 n) #\0).
0bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c00: 20 20 20 20 65 78 70 2d 73 74 72 29 0a 20 20 20 exp-str).
0c10: 20 20 20 20 20 20 20 20 20 20 5d 0a 20 20 20 20 ].
0c20: 20 20 20 20 20 20 20 20 5b 28 3d 20 66 72 61 63 [(= frac
0c30: 2d 6c 65 6e 20 64 69 67 69 74 73 29 20 3b 3b 20 -len digits) ;;
0c40: 66 72 61 63 2d 70 61 72 74 20 69 73 20 65 78 61 frac-part is exa
0c50: 63 74 6c 79 20 74 68 65 20 72 69 67 68 74 20 73 ctly the right s
0c60: 69 7a 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ize.
0c70: 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 (string-append
0c80: 70 72 65 2d 73 74 72 20 22 2e 22 0a 20 20 20 20 pre-str ".".
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ca0: 20 20 20 20 20 20 20 20 66 72 61 63 2d 73 74 72 frac-str
0cb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 65 78 70 exp
0cd0: 2d 73 74 72 29 0a 20 20 20 20 20 20 20 20 20 20 -str).
0ce0: 20 20 20 5d 0a 20 20 20 20 20 20 20 20 20 20 20 ].
0cf0: 20 5b 65 6c 73 65 20 3b 3b 20 6d 75 73 74 20 72 [else ;; must r
0d00: 6f 75 6e 64 20 74 6f 20 73 68 72 69 6e 6b 20 66 ound to shrink f
0d10: 72 61 63 2d 70 61 72 74 0a 20 20 20 20 20 20 20 rac-part.
0d20: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 20 5b 66 (let* ( [f
0d30: 69 72 73 74 2d 70 61 72 74 20 28 73 75 62 73 74 irst-part (subst
0d40: 72 69 6e 67 20 66 72 61 63 2d 73 74 72 20 30 20 ring frac-str 0
0d50: 64 69 67 69 74 73 29 5d 0a 20 20 20 20 20 20 20 digits)].
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 6c [l
0d70: 61 73 74 2d 70 61 72 74 20 20 28 73 75 62 73 74 ast-part (subst
0d80: 72 69 6e 67 20 66 72 61 63 2d 73 74 72 20 64 69 ring frac-str di
0d90: 67 69 74 73 20 66 72 61 63 2d 6c 65 6e 29 5d 0a gits frac-len)].
0da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0db0: 20 20 20 20 20 3b 3b 20 4e 42 3a 20 53 63 68 65 ;; NB: Sche
0dc0: 6d 65 20 75 73 65 73 20 22 52 6f 75 6e 64 20 74 me uses "Round t
0dd0: 6f 20 45 76 65 6e 20 52 75 6c 65 22 20 66 6f 72 o Even Rule" for
0de0: 20 2e 35 0a 20 20 20 20 20 20 20 20 20 20 20 20 .5.
0df0: 20 20 20 20 20 20 20 20 20 5b 72 6f 75 6e 64 65 [rounde
0e00: 64 2d 66 72 61 63 0a 09 09 20 20 20 20 20 3b 3b d-frac... ;;
0e10: 20 4e 42 3a 20 65 78 61 63 74 20 69 73 20 72 36 NB: exact is r6
0e20: 3b 20 72 35 20 69 73 20 69 6e 65 78 61 63 74 2d ; r5 is inexact-
0e30: 3e 65 78 61 63 74 0a 20 20 20 20 20 20 20 20 20 >exact.
0e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 78 (ex
0e50: 61 63 74 20 28 72 6f 75 6e 64 20 28 73 74 72 69 act (round (stri
0e60: 6e 67 2d 3e 6e 75 6d 62 65 72 0a 20 20 20 20 20 ng->number.
0e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e90: 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e (string-appen
0ea0: 64 20 66 69 72 73 74 2d 70 61 72 74 20 22 2e 22 d first-part "."
0eb0: 20 6c 61 73 74 2d 70 61 72 74 29 29 29 29 0a 20 last-part)))).
0ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ed0: 20 20 20 20 20 5d 0a 09 09 20 20 20 20 20 5b 72 ]... [r
0ee0: 6f 75 6e 64 65 64 2d 66 72 61 63 2d 73 74 72 20 ounded-frac-str
0ef0: 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 (number->string
0f00: 72 6f 75 6e 64 65 64 2d 66 72 61 63 29 5d 0a 20 rounded-frac)].
0f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f20: 20 20 20 20 5b 72 6f 75 6e 64 65 64 2d 66 72 61 [rounded-fra
0f30: 63 2d 6c 65 6e 20 28 73 74 72 69 6e 67 2d 6c 65 c-len (string-le
0f40: 6e 67 74 68 20 72 6f 75 6e 64 65 64 2d 66 72 61 ngth rounded-fra
0f50: 63 2d 73 74 72 29 5d 0a 20 20 20 20 20 20 20 20 c-str)].
0f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 63 61 [ca
0f70: 72 72 79 3f 20 28 61 6e 64 20 28 6e 6f 74 20 28 rry? (and (not (
0f80: 7a 65 72 6f 3f 20 72 6f 75 6e 64 65 64 2d 66 72 zero? rounded-fr
0f90: 61 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ac)).
0fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fb0: 20 20 20 20 20 20 20 28 3e 20 72 6f 75 6e 64 65 (> rounde
0fc0: 64 2d 66 72 61 63 2d 6c 65 6e 20 64 69 67 69 74 d-frac-len digit
0fd0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
0fe0: 20 20 20 20 20 20 20 20 20 20 5d 0a 20 20 20 20 ].
0ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1000: 20 5b 6e 65 77 2d 66 72 61 63 0a 20 20 20 20 20 [new-frac.
1010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1020: 20 28 6c 65 74 20 28 20 28 70 72 65 2d 66 72 61 (let ( (pre-fra
1030: 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 c.
1040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1050: 28 69 66 20 63 61 72 72 79 3f 20 3b 3b 20 74 72 (if carry? ;; tr
1060: 69 6d 20 6c 65 61 64 69 6e 67 20 22 31 22 0a 20 im leading "1".
1070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1090: 20 28 73 75 62 73 74 72 69 6e 67 20 72 6f 75 6e (substring roun
10a0: 64 65 64 2d 66 72 61 63 2d 73 74 72 20 31 20 28 ded-frac-str 1 (
10b0: 6d 69 6e 20 72 6f 75 6e 64 65 64 2d 66 72 61 63 min rounded-frac
10c0: 2d 6c 65 6e 20 64 69 67 69 74 73 29 29 0a 20 20 -len digits)).
10d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10f0: 28 73 75 62 73 74 72 69 6e 67 20 72 6f 75 6e 64 (substring round
1100: 65 64 2d 66 72 61 63 2d 73 74 72 20 30 20 28 6d ed-frac-str 0 (m
1110: 69 6e 20 72 6f 75 6e 64 65 64 2d 66 72 61 63 2d in rounded-frac-
1120: 6c 65 6e 20 64 69 67 69 74 73 29 29 29 20 3b 3b len digits))) ;;
1130: 20 6d 61 79 20 62 65 20 7a 65 72 6f 20 6c 65 6e may be zero len
1140: 67 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 gth.
1150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1160: 20 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ).
1170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 )
1180: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1190: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3c 20 (if (<
11a0: 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 70 (string-length p
11b0: 72 65 2d 66 72 61 63 29 20 64 69 67 69 74 73 29 re-frac) digits)
11c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
11e0: 72 69 6e 67 2d 67 72 6f 77 20 70 72 65 2d 66 72 ring-grow pre-fr
11f0: 61 63 20 64 69 67 69 74 73 20 23 5c 30 29 0a 20 ac digits #\0).
1200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1210: 20 20 20 20 20 20 20 20 20 20 20 70 72 65 2d 66 pre-f
1220: 72 61 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 rac)).
1230: 20 20 20 20 20 20 20 20 20 20 20 20 5d 0a 20 20 ].
1240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1250: 20 20 29 0a 3b 3b 40 40 44 45 42 55 47 0a 3b 3b ).;;@@DEBUG.;;
1260: 28 66 6f 72 6d 61 74 20 23 74 20 22 40 40 20 66 (format #t "@@ f
1270: 69 72 73 74 2d 70 61 72 74 3d 7e 73 20 6c 61 73 irst-part=~s las
1280: 74 2d 70 61 72 74 3d 7e 73 20 72 6f 75 6e 64 65 t-part=~s rounde
1290: 64 2d 66 72 61 63 3d 7e 73 20 63 61 72 72 79 3f d-frac=~s carry?
12a0: 3d 7e 73 20 7e 25 22 20 66 69 72 73 74 2d 70 61 =~s ~%" first-pa
12b0: 72 74 20 6c 61 73 74 2d 70 61 72 74 20 72 6f 75 rt last-part rou
12c0: 6e 64 65 64 2d 66 72 61 63 20 63 61 72 72 79 3f nded-frac carry?
12d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12e0: 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a (string-append.
12f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1300: 28 69 66 20 63 61 72 72 79 3f 20 28 6e 75 6d 62 (if carry? (numb
1310: 65 72 2d 3e 73 74 72 69 6e 67 20 28 2b 20 31 20 er->string (+ 1
1320: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
1330: 70 72 65 2d 73 74 72 29 29 29 20 70 72 65 2d 73 pre-str))) pre-s
1340: 74 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 tr).
1350: 20 20 20 20 22 2e 22 0a 20 20 20 20 20 20 20 20 ".".
1360: 20 20 20 20 20 20 20 20 6e 65 77 2d 66 72 61 63 new-frac
1370: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1380: 20 65 78 70 2d 73 74 72 29 29 5d 0a 20 20 20 20 exp-str))].
1390: 20 20 20 20 20 20 20 20 29 20 29 20 29 0a 20 20 ) ) ).
13a0: 20 20 20 20 0a 20 20 20 20 20 20 0a 20 20 20 20 . .
13b0: 20 20 28 64 65 66 69 6e 65 20 28 66 6f 72 6d 61 (define (forma
13c0: 74 2d 66 69 78 65 64 20 6e 75 6d 62 65 72 2d 6f t-fixed number-o
13d0: 72 2d 73 74 72 69 6e 67 20 77 69 64 74 68 20 64 r-string width d
13e0: 69 67 69 74 73 29 20 3b 20 72 65 74 75 72 6e 73 igits) ; returns
13f0: 20 61 20 73 74 72 69 6e 67 0a 3b 3b 40 40 44 45 a string.;;@@DE
1400: 42 55 47 0a 3b 3b 28 66 6f 72 6d 61 74 20 23 74 BUG.;;(format #t
1410: 20 22 7e 25 28 66 6f 72 6d 61 74 2d 66 69 78 65 "~%(format-fixe
1420: 64 20 6e 75 6d 62 65 72 2d 6f 72 2d 73 74 72 69 d number-or-stri
1430: 6e 67 3d 7e 73 20 77 69 64 74 68 3d 7e 73 20 64 ng=~s width=~s d
1440: 69 67 69 74 73 3d 7e 73 29 7e 25 22 20 6e 75 6d igits=~s)~%" num
1450: 62 65 72 2d 6f 72 2d 73 74 72 69 6e 67 20 77 69 ber-or-string wi
1460: 64 74 68 20 64 69 67 69 74 73 29 0a 0a 20 20 20 dth digits)..
1470: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
1480: 20 20 20 20 20 5b 28 73 74 72 69 6e 67 3f 20 6e [(string? n
1490: 75 6d 62 65 72 2d 6f 72 2d 73 74 72 69 6e 67 29 umber-or-string)
14a0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 . (str
14b0: 69 6e 67 2d 67 72 6f 77 20 6e 75 6d 62 65 72 2d ing-grow number-
14c0: 6f 72 2d 73 74 72 69 6e 67 20 77 69 64 74 68 20 or-string width
14d0: 23 5c 73 70 61 63 65 29 0a 20 20 20 20 20 20 20 #\space).
14e0: 20 20 20 20 5d 0a 20 20 20 20 20 20 20 20 20 20 ].
14f0: 5b 28 6e 75 6d 62 65 72 3f 20 6e 75 6d 62 65 72 [(number? number
1500: 2d 6f 72 2d 73 74 72 69 6e 67 29 0a 20 20 20 20 -or-string).
1510: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 20 5b (let* ( [
1520: 6e 75 6d 20 28 72 65 61 6c 2d 70 61 72 74 20 6e num (real-part n
1530: 75 6d 62 65 72 2d 6f 72 2d 73 74 72 69 6e 67 29 umber-or-string)
1540: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ].
1550: 20 20 20 20 20 5b 72 65 61 6c 20 28 69 66 20 64 [real (if d
1560: 69 67 69 74 73 20 28 2b 20 30 2e 30 20 6e 75 6d igits (+ 0.0 num
1570: 29 20 6e 75 6d 29 5d 0a 20 20 20 20 20 20 20 20 ) num)].
1580: 20 20 20 20 20 20 20 20 20 20 20 5b 69 6d 61 67 [imag
1590: 20 28 69 6d 61 67 2d 70 61 72 74 20 6e 75 6d 62 (imag-part numb
15a0: 65 72 2d 6f 72 2d 73 74 72 69 6e 67 29 5d 0a 20 er-or-string)].
15b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
15d0: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
15e0: 20 20 20 20 5b 28 6e 6f 74 20 28 7a 65 72 6f 3f [(not (zero?
15f0: 20 69 6d 61 67 29 29 0a 20 20 20 20 20 20 20 20 imag)).
1600: 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d (string-
1610: 67 72 6f 77 0a 20 20 20 20 20 20 20 20 20 20 20 grow.
1620: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 61 70 (string-ap
1630: 70 65 6e 64 20 28 66 6f 72 6d 61 74 2d 66 69 78 pend (format-fix
1640: 65 64 20 72 65 61 6c 20 30 20 64 69 67 69 74 73 ed real 0 digits
1650: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1670: 20 20 28 69 66 20 28 6e 65 67 61 74 69 76 65 3f (if (negative?
1680: 20 69 6d 61 67 29 20 22 22 20 22 2b 22 29 0a 20 imag) "" "+").
1690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
16b0: 66 6f 72 6d 61 74 2d 66 69 78 65 64 20 69 6d 61 format-fixed ima
16c0: 67 20 30 20 64 69 67 69 74 73 29 0a 20 20 20 20 g 0 digits).
16d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16e0: 20 20 20 20 20 20 20 20 20 20 20 20 22 69 22 29 "i")
16f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1700: 20 20 77 69 64 74 68 0a 20 20 20 20 20 20 20 20 width.
1710: 20 20 20 20 20 20 20 20 20 23 5c 73 70 61 63 65 #\space
1720: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1730: 20 20 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 ].
1740: 20 20 20 5b 64 69 67 69 74 73 0a 20 20 20 20 20 [digits.
1750: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
1760: 20 28 20 5b 6e 75 6d 2d 73 74 72 20 20 20 28 6e ( [num-str (n
1770: 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 28 69 umber->string (i
1780: 66 20 28 72 61 74 69 6f 6e 61 6c 3f 20 72 65 61 f (rational? rea
1790: 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 l).
17a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c0: 20 20 20 20 20 20 20 20 20 20 28 2b 20 30 2e 30 (+ 0.0
17d0: 20 72 65 61 6c 29 0a 20 20 20 20 20 20 20 20 20 real).
17e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 re
1810: 61 6c 29 29 5d 0a 20 20 20 20 20 20 20 20 20 20 al))].
1820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 64 [d
1830: 6f 74 2d 69 6e 64 65 78 20 28 73 74 72 69 6e 67 ot-index (string
1840: 2d 69 6e 64 65 78 20 20 6e 75 6d 2d 73 74 72 20 -index num-str
1850: 23 5c 2e 29 5d 0a 20 20 20 20 20 20 20 20 20 20 #\.)].
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 65 [e
1870: 78 70 2d 69 6e 64 65 78 20 28 73 74 72 69 6e 67 xp-index (string
1880: 2d 69 6e 64 65 78 20 20 6e 75 6d 2d 73 74 72 20 -index num-str
1890: 23 5c 65 29 5d 0a 20 20 20 20 20 20 20 20 20 20 #\e)].
18a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 6c [l
18b0: 65 6e 67 74 68 20 20 20 20 28 73 74 72 69 6e 67 ength (string
18c0: 2d 6c 65 6e 67 74 68 20 6e 75 6d 2d 73 74 72 29 -length num-str)
18d0: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ].
18e0: 20 20 20 20 20 20 20 20 20 20 5b 70 72 65 2d 73 [pre-s
18f0: 74 72 69 6e 67 0a 20 20 20 20 20 20 20 20 20 20 tring.
1900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1910: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
1920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1930: 28 28 61 6e 64 20 65 78 70 2d 69 6e 64 65 78 20 ((and exp-index
1940: 28 6e 6f 74 20 64 6f 74 2d 69 6e 64 65 78 29 29 (not dot-index))
1950: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1960: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 (su
1970: 62 73 74 72 69 6e 67 20 6e 75 6d 2d 73 74 72 20 bstring num-str
1980: 30 20 65 78 70 2d 69 6e 64 65 78 29 0a 20 20 20 0 exp-index).
1990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a0: 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 ).
19b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c0: 20 20 20 20 20 20 28 64 6f 74 2d 69 6e 64 65 78 (dot-index
19d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 (su
19f0: 62 73 74 72 69 6e 67 20 6e 75 6d 2d 73 74 72 20 bstring num-str
1a00: 30 20 64 6f 74 2d 69 6e 64 65 78 29 0a 20 20 20 0 dot-index).
1a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a20: 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 ).
1a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a40: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
1a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a60: 20 20 20 20 20 20 20 20 6e 75 6d 2d 73 74 72 29 num-str)
1a70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1a80: 20 20 20 20 20 20 20 20 20 20 20 5d 0a 20 20 20 ].
1a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1aa0: 20 20 20 20 20 5b 65 78 70 2d 73 74 72 69 6e 67 [exp-string
1ab0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1ac0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 65 78 (if ex
1ad0: 70 2d 69 6e 64 65 78 20 28 73 75 62 73 74 72 69 p-index (substri
1ae0: 6e 67 20 6e 75 6d 2d 73 74 72 20 65 78 70 2d 69 ng num-str exp-i
1af0: 6e 64 65 78 20 6c 65 6e 67 74 68 29 20 22 22 29 ndex length) "")
1b00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1b10: 20 20 20 20 20 20 20 20 20 20 5d 0a 20 20 20 20 ].
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b30: 20 20 20 20 5b 66 72 61 63 2d 73 74 72 69 6e 67 [frac-string
1b40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1b50: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
1b60: 20 28 64 6f 74 2d 69 64 78 20 28 69 66 20 64 6f (dot-idx (if do
1b70: 74 2d 69 6e 64 65 78 20 64 6f 74 2d 69 6e 64 65 t-index dot-inde
1b80: 78 20 2d 31 29 29 20 29 0a 20 20 20 20 20 20 20 x -1)) ).
1b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ba0: 20 20 20 20 28 69 66 20 65 78 70 2d 69 6e 64 65 (if exp-inde
1bb0: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
1bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bd0: 20 28 73 75 62 73 74 72 69 6e 67 20 6e 75 6d 2d (substring num-
1be0: 73 74 72 20 28 2b 20 64 6f 74 2d 69 64 78 20 31 str (+ dot-idx 1
1bf0: 29 20 65 78 70 2d 69 6e 64 65 78 29 0a 20 20 20 ) exp-index).
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c10: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 62 (sub
1c20: 73 74 72 69 6e 67 20 6e 75 6d 2d 73 74 72 20 28 string num-str (
1c30: 2b 20 64 6f 74 2d 69 64 78 20 31 29 20 6c 65 6e + dot-idx 1) len
1c40: 67 74 68 29 29 29 0a 20 20 20 20 20 20 20 20 20 gth))).
1c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c60: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ].
1c70: 20 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 ).
1c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
1c90: 74 72 69 6e 67 2d 67 72 6f 77 0a 20 20 20 20 20 tring-grow.
1ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
1cb0: 66 20 64 6f 74 2d 69 6e 64 65 78 0a 20 20 20 20 f dot-index.
1cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cd0: 20 28 63 6f 6d 70 6f 73 65 2d 77 69 74 68 2d 64 (compose-with-d
1ce0: 69 67 69 74 73 20 64 69 67 69 74 73 0a 20 20 20 igits digits.
1cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d10: 20 20 20 20 20 20 20 70 72 65 2d 73 74 72 69 6e pre-strin
1d20: 67 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 g.
1d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d40: 20 20 20 20 20 20 20 20 20 20 20 20 66 72 61 63 frac
1d50: 2d 73 74 72 69 6e 67 0a 20 20 20 20 20 20 20 20 -string.
1d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d80: 20 20 65 78 70 2d 73 74 72 69 6e 67 29 0a 20 20 exp-string).
1d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1da0: 20 20 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e (string-appen
1db0: 64 20 70 72 65 2d 73 74 72 69 6e 67 20 65 78 70 d pre-string exp
1dc0: 2d 73 74 72 69 6e 67 29 29 0a 20 20 20 20 20 20 -string)).
1dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 77 69 64 wid
1de0: 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 th.
1df0: 20 20 20 20 20 20 23 5c 73 70 61 63 65 29 0a 20 #\space).
1e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e10: 20 29 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 )].
1e20: 20 20 20 5b 65 6c 73 65 20 3b 3b 20 6e 6f 20 64 [else ;; no d
1e30: 69 67 69 74 73 0a 20 20 20 20 20 20 20 20 20 20 igits.
1e40: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 67 72 (string-gr
1e50: 6f 77 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 ow (number->stri
1e60: 6e 67 20 72 65 61 6c 29 20 77 69 64 74 68 20 23 ng real) width #
1e70: 5c 73 70 61 63 65 29 5d 29 0a 20 20 20 20 20 20 \space)]).
1e80: 20 20 20 20 20 20 20 29 5d 0a 20 20 20 20 20 20 )].
1e90: 20 20 20 20 5b 65 6c 73 65 0a 20 20 20 20 20 20 [else.
1ea0: 20 20 20 20 20 28 65 72 72 6f 72 20 27 66 6f 72 (error 'for
1eb0: 6d 61 74 20 22 7e 46 20 72 65 71 75 69 72 65 73 mat "~F requires
1ec0: 20 61 20 6e 75 6d 62 65 72 20 6f 72 20 61 20 73 a number or a s
1ed0: 74 72 69 6e 67 22 20 6e 75 6d 62 65 72 2d 6f 72 tring" number-or
1ee0: 2d 73 74 72 69 6e 67 29 5d 29 0a 20 20 20 20 20 -string)]).
1ef0: 20 20 20 29 0a 20 20 20 20 20 20 0a 0a 20 20 20 ). ..
1f00: 20 20 20 28 64 65 66 69 6e 65 20 64 6f 63 75 6d (define docum
1f10: 65 6e 74 61 74 69 6f 6e 2d 73 74 72 69 6e 67 0a entation-string.
1f20: 20 20 20 20 20 20 20 20 22 28 66 6f 72 6d 61 74 "(format
1f30: 20 5b 3c 70 6f 72 74 3e 5d 20 3c 66 6f 72 6d 61 [<port>] <forma
1f40: 74 2d 73 74 72 69 6e 67 3e 20 5b 3c 61 72 67 3e t-string> [<arg>
1f50: 2e 2e 2e 5d 29 20 2d 2d 20 3c 70 6f 72 74 3e 20 ...]) -- <port>
1f60: 69 73 20 23 74 2c 20 23 66 20 6f 72 20 61 6e 20 is #t, #f or an
1f70: 6f 75 74 70 75 74 2d 70 6f 72 74 0a 4f 50 54 49 output-port.OPTI
1f80: 4f 4e 20 20 5b 4d 4e 45 4d 4f 4e 49 43 5d 20 20 ON [MNEMONIC]
1f90: 20 20 20 20 44 45 53 43 52 49 50 54 49 4f 4e 20 DESCRIPTION
1fa0: 20 20 20 20 2d 2d 20 49 6d 70 6c 65 6d 65 6e 74 -- Implement
1fb0: 61 74 69 6f 6e 20 41 73 73 75 6d 65 73 20 41 53 ation Assumes AS
1fc0: 43 49 49 20 54 65 78 74 20 45 6e 63 6f 64 69 6e CII Text Encodin
1fd0: 67 0a 7e 48 20 20 20 20 20 20 5b 48 65 6c 70 5d g.~H [Help]
1fe0: 20 20 20 20 20 20 20 20 20 20 6f 75 74 70 75 74 output
1ff0: 20 74 68 69 73 20 74 65 78 74 0a 7e 41 20 20 20 this text.~A
2000: 20 20 20 5b 41 6e 79 5d 20 20 20 20 20 20 20 20 [Any]
2010: 20 20 20 28 64 69 73 70 6c 61 79 20 61 72 67 29 (display arg)
2020: 20 66 6f 72 20 68 75 6d 61 6e 73 0a 7e 53 20 20 for humans.~S
2030: 20 20 20 20 5b 53 6c 61 73 68 69 66 69 65 64 5d [Slashified]
2040: 20 20 20 20 28 77 72 69 74 65 20 61 72 67 29 20 (write arg)
2050: 66 6f 72 20 70 61 72 73 65 72 73 0a 7e 57 20 20 for parsers.~W
2060: 20 20 20 20 5b 57 72 69 74 65 43 69 72 63 75 6c [WriteCircul
2070: 61 72 5d 20 6c 69 6b 65 20 7e 73 20 62 75 74 20 ar] like ~s but
2080: 6f 75 74 70 75 74 73 20 63 69 72 63 75 6c 61 72 outputs circular
2090: 20 61 6e 64 20 72 65 63 75 72 73 69 76 65 20 64 and recursive d
20a0: 61 74 61 20 73 74 72 75 63 74 75 72 65 73 0a 7e ata structures.~
20b0: 7e 20 20 20 20 20 20 5b 74 69 6c 64 65 5d 20 20 ~ [tilde]
20c0: 20 20 20 20 20 20 20 6f 75 74 70 75 74 20 61 20 output a
20d0: 74 69 6c 64 65 0a 7e 54 20 20 20 20 20 20 5b 54 tilde.~T [T
20e0: 61 62 5d 20 20 20 20 20 20 20 20 20 20 20 6f 75 ab] ou
20f0: 74 70 75 74 20 61 20 74 61 62 20 63 68 61 72 61 tput a tab chara
2100: 63 74 65 72 0a 7e 25 20 20 20 20 20 20 5b 4e 65 cter.~% [Ne
2110: 77 6c 69 6e 65 5d 20 20 20 20 20 20 20 6f 75 74 wline] out
2120: 70 75 74 20 61 20 6e 65 77 6c 69 6e 65 20 63 68 put a newline ch
2130: 61 72 61 63 74 65 72 0a 7e 26 20 20 20 20 20 20 aracter.~&
2140: 5b 46 72 65 73 68 6c 69 6e 65 5d 20 20 20 20 20 [Freshline]
2150: 6f 75 74 70 75 74 20 61 20 6e 65 77 6c 69 6e 65 output a newline
2160: 20 63 68 61 72 61 63 74 65 72 20 69 66 20 74 68 character if th
2170: 65 20 70 72 65 76 69 6f 75 73 20 6f 75 74 70 75 e previous outpu
2180: 74 20 77 61 73 20 6e 6f 74 20 61 20 6e 65 77 6c t was not a newl
2190: 69 6e 65 0a 7e 44 20 20 20 20 20 20 5b 44 65 63 ine.~D [Dec
21a0: 69 6d 61 6c 5d 20 20 20 20 20 20 20 74 68 65 20 imal] the
21b0: 61 72 67 20 69 73 20 61 20 6e 75 6d 62 65 72 20 arg is a number
21c0: 77 68 69 63 68 20 69 73 20 6f 75 74 70 75 74 20 which is output
21d0: 69 6e 20 64 65 63 69 6d 61 6c 20 72 61 64 69 78 in decimal radix
21e0: 0a 7e 58 20 20 20 20 20 20 5b 68 65 58 61 64 65 .~X [heXade
21f0: 63 69 6d 61 6c 5d 20 20 20 74 68 65 20 61 72 67 cimal] the arg
2200: 20 69 73 20 61 20 6e 75 6d 62 65 72 20 77 68 69 is a number whi
2210: 63 68 20 69 73 20 6f 75 74 70 75 74 20 69 6e 20 ch is output in
2220: 68 65 78 64 65 63 69 6d 61 6c 20 72 61 64 69 78 hexdecimal radix
2230: 0a 7e 4f 20 20 20 20 20 20 5b 4f 63 74 61 6c 5d .~O [Octal]
2240: 20 20 20 20 20 20 20 20 20 74 68 65 20 61 72 67 the arg
2250: 20 69 73 20 61 20 6e 75 6d 62 65 72 20 77 68 69 is a number whi
2260: 63 68 20 69 73 20 6f 75 74 70 75 74 20 69 6e 20 ch is output in
2270: 6f 63 74 61 6c 20 72 61 64 69 78 0a 7e 42 20 20 octal radix.~B
2280: 20 20 20 20 5b 42 69 6e 61 72 79 5d 20 20 20 20 [Binary]
2290: 20 20 20 20 74 68 65 20 61 72 67 20 69 73 20 61 the arg is a
22a0: 20 6e 75 6d 62 65 72 20 77 68 69 63 68 20 69 73 number which is
22b0: 20 6f 75 74 70 75 74 20 69 6e 20 62 69 6e 61 72 output in binar
22c0: 79 20 72 61 64 69 78 0a 7e 77 2c 64 46 20 20 20 y radix.~w,dF
22d0: 5b 46 69 78 65 64 5d 20 20 20 20 20 20 20 20 20 [Fixed]
22e0: 74 68 65 20 61 72 67 20 69 73 20 61 20 73 74 72 the arg is a str
22f0: 69 6e 67 20 6f 72 20 6e 75 6d 62 65 72 20 77 68 ing or number wh
2300: 69 63 68 20 68 61 73 20 77 69 64 74 68 20 77 20 ich has width w
2310: 61 6e 64 20 64 20 64 69 67 69 74 73 20 61 66 74 and d digits aft
2320: 65 72 20 74 68 65 20 64 65 63 69 6d 61 6c 0a 7e er the decimal.~
2330: 43 20 20 20 20 20 20 5b 43 68 61 72 61 63 74 65 C [Characte
2340: 72 5d 20 20 20 20 20 63 68 61 72 61 74 65 72 20 r] charater
2350: 61 72 67 20 69 73 20 6f 75 74 70 75 74 20 62 79 arg is output by
2360: 20 77 72 69 74 65 2d 63 68 61 72 0a 7e 5f 20 20 write-char.~_
2370: 20 20 20 20 5b 53 70 61 63 65 5d 20 20 20 20 20 [Space]
2380: 20 20 20 20 61 20 73 69 6e 67 6c 65 20 73 70 61 a single spa
2390: 63 65 20 63 68 61 72 61 63 74 65 72 20 69 73 20 ce character is
23a0: 6f 75 74 70 75 74 0a 7e 59 20 20 20 20 20 20 5b output.~Y [
23b0: 59 75 70 70 69 66 79 5d 20 20 20 20 20 20 20 74 Yuppify] t
23c0: 68 65 20 6c 69 73 74 20 61 72 67 20 69 73 20 70 he list arg is p
23d0: 72 65 74 74 79 2d 70 72 69 6e 74 65 64 20 74 6f retty-printed to
23e0: 20 74 68 65 20 6f 75 74 70 75 74 0a 7e 3f 20 20 the output.~?
23f0: 20 20 20 20 5b 49 6e 64 69 72 65 63 74 69 6f 6e [Indirection
2400: 5d 20 20 20 72 65 63 75 72 73 69 76 65 20 66 6f ] recursive fo
2410: 72 6d 61 74 3a 20 6e 65 78 74 20 32 20 61 72 67 rmat: next 2 arg
2420: 73 20 61 72 65 20 66 6f 72 6d 61 74 2d 73 74 72 s are format-str
2430: 69 6e 67 20 61 6e 64 20 6c 69 73 74 20 6f 66 20 ing and list of
2440: 61 72 67 75 6d 65 6e 74 73 0a 7e 4b 20 20 20 20 arguments.~K
2450: 20 20 5b 49 6e 64 69 72 65 63 74 69 6f 6e 5d 20 [Indirection]
2460: 20 20 73 61 6d 65 20 61 73 20 7e 3f 0a 22 0a 20 same as ~?.".
2470: 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 0a ). .
2480: 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 72 (define (r
2490: 65 71 75 69 72 65 2d 61 6e 2d 61 72 67 20 61 72 equire-an-arg ar
24a0: 67 73 29 0a 20 20 20 20 20 20 20 20 28 77 68 65 gs). (whe
24b0: 6e 20 28 6e 75 6c 6c 3f 20 61 72 67 73 29 0a 20 n (null? args).
24c0: 20 20 20 20 20 20 20 20 20 28 70 72 6f 62 6c 65 (proble
24d0: 6d 20 22 74 6f 6f 20 66 65 77 20 61 72 67 75 6d m "too few argum
24e0: 65 6e 74 73 22 29 29 0a 20 20 20 20 20 20 20 20 ents")).
24f0: 29 0a 20 20 20 20 20 20 0a 20 20 20 20 20 20 28 ). . (
2500: 64 65 66 69 6e 65 20 28 66 6f 72 6d 61 74 2d 68 define (format-h
2510: 65 6c 70 20 70 20 66 6f 72 6d 61 74 2d 73 74 72 elp p format-str
2520: 67 20 61 72 67 6c 69 73 74 29 0a 20 20 20 20 20 g arglist).
2530: 20 20 20 0a 20 20 20 20 20 20 20 20 28 6c 65 74 . (let
2540: 72 65 63 20 28 0a 20 20 20 20 20 20 20 20 20 20 rec (.
2550: 20 20 20 20 20 20 20 5b 6c 65 6e 67 74 68 2d 6f [length-o
2560: 66 2d 66 6f 72 6d 61 74 2d 73 74 72 69 6e 67 20 f-format-string
2570: 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 66 (string-length f
2580: 6f 72 6d 61 74 2d 73 74 72 67 29 5d 0a 20 20 20 ormat-strg)].
2590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 .
25a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25b0: 5b 61 6e 79 63 68 61 72 2d 64 69 73 70 61 74 63 [anychar-dispatc
25c0: 68 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 h .
25d0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
25e0: 64 61 20 28 70 6f 73 20 61 72 67 6c 69 73 74 20 da (pos arglist
25f0: 6c 61 73 74 2d 77 61 73 2d 6e 65 77 6c 69 6e 65 last-was-newline
2600: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
2610: 20 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 70 (if (>= p
2620: 6f 73 20 6c 65 6e 67 74 68 2d 6f 66 2d 66 6f 72 os length-of-for
2630: 6d 61 74 2d 73 74 72 69 6e 67 29 20 0a 20 20 20 mat-string) .
2640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2650: 20 20 20 61 72 67 6c 69 73 74 20 3b 20 72 65 74 arglist ; ret
2660: 75 72 6e 20 75 6e 75 73 65 64 20 61 72 67 73 20 urn unused args
2670: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2680: 20 20 20 20 20 20 20 28 6c 65 74 20 28 20 5b 63 (let ( [c
2690: 68 61 72 20 28 73 74 72 69 6e 67 2d 72 65 66 20 har (string-ref
26a0: 66 6f 72 6d 61 74 2d 73 74 72 67 20 70 6f 73 29 format-strg pos)
26b0: 5d 20 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 ] ) .
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
26d0: 6e 64 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 nd .
26e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26f0: 20 20 20 20 20 20 20 20 20 5b 28 65 71 76 3f 20 [(eqv?
2700: 63 68 61 72 20 23 5c 7e 29 20 20 20 0a 20 20 20 char #\~) .
2710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2720: 20 20 20 20 20 20 20 20 28 74 69 6c 64 65 2d 64 (tilde-d
2730: 69 73 70 61 74 63 68 20 28 2b 20 70 6f 73 20 31 ispatch (+ pos 1
2740: 29 20 61 72 67 6c 69 73 74 20 6c 61 73 74 2d 77 ) arglist last-w
2750: 61 73 2d 6e 65 77 6c 69 6e 65 29 5d 0a 20 20 20 as-newline)].
2760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2770: 20 20 20 20 20 20 20 5b 65 6c 73 65 20 20 20 20 [else
2780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a .
2790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27a0: 20 20 20 20 20 20 20 20 20 20 20 28 77 72 69 74 (writ
27b0: 65 2d 63 68 61 72 20 63 68 61 72 20 70 29 20 20 e-char char p)
27c0: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
27d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
27e0: 61 6e 79 63 68 61 72 2d 64 69 73 70 61 74 63 68 anychar-dispatch
27f0: 20 28 2b 20 70 6f 73 20 31 29 20 61 72 67 6c 69 (+ pos 1) argli
2800: 73 74 20 23 66 29 20 20 20 20 20 20 20 20 0a 20 st #f) .
2810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2820: 20 20 20 20 20 20 20 20 20 20 5d 29 20 20 20 20 ])
2830: 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 .
2840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2850: 20 20 29 29 29 20 20 20 20 20 0a 20 20 20 20 20 ))) .
2860: 20 20 20 20 20 20 20 20 20 20 20 20 20 5d 20 3b ] ;
2870: 20 65 6e 64 20 61 6e 79 63 68 61 72 2d 64 69 73 end anychar-dis
2880: 70 61 74 63 68 0a 20 20 20 20 20 20 20 20 20 20 patch.
2890: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
28a0: 20 20 20 20 20 20 20 20 20 5b 68 61 73 2d 6e 65 [has-ne
28b0: 77 6c 69 6e 65 3f 0a 20 20 20 20 20 20 20 20 20 wline?.
28c0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
28d0: 20 28 77 68 61 74 65 76 65 72 20 6c 61 73 74 2d (whatever last-
28e0: 77 61 73 2d 6e 65 77 6c 69 6e 65 29 0a 20 20 20 was-newline).
28f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2900: 20 28 6f 72 20 28 65 71 76 3f 20 77 68 61 74 65 (or (eqv? whate
2910: 76 65 72 20 23 5c 6e 65 77 6c 69 6e 65 29 0a 20 ver #\newline).
2920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2930: 20 20 20 20 20 20 20 28 61 6e 64 20 28 73 74 72 (and (str
2940: 69 6e 67 3f 20 77 68 61 74 65 76 65 72 29 0a 20 ing? whatever).
2950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2960: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
2970: 20 28 20 5b 6c 65 6e 20 28 73 74 72 69 6e 67 2d ( [len (string-
2980: 6c 65 6e 67 74 68 20 77 68 61 74 65 76 65 72 29 length whatever)
2990: 5d 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ] ).
29a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29b0: 20 20 20 28 69 66 20 28 7a 65 72 6f 3f 20 6c 65 (if (zero? le
29c0: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
29d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29e0: 20 20 20 20 6c 61 73 74 2d 77 61 73 2d 6e 65 77 last-was-new
29f0: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 line.
2a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a10: 20 20 20 20 20 20 28 65 71 76 3f 20 23 5c 6e 65 (eqv? #\ne
2a20: 77 6c 69 6e 65 20 28 73 74 72 69 6e 67 2d 72 65 wline (string-re
2a30: 66 20 77 68 61 74 65 76 65 72 20 28 2d 20 6c 65 f whatever (- le
2a40: 6e 20 31 29 29 29 29 29 29 29 0a 20 20 20 20 20 n 1))))))).
2a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 )
2a60: 5d 20 3b 20 65 6e 64 20 68 61 73 2d 6e 65 77 6c ] ; end has-newl
2a70: 69 6e 65 3f 0a 20 20 20 20 20 20 20 20 20 20 20 ine?.
2a80: 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 .
2a90: 20 20 20 20 20 20 20 20 5b 74 69 6c 64 65 2d 64 [tilde-d
2aa0: 69 73 70 61 74 63 68 20 20 20 20 20 20 20 20 20 ispatch
2ab0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2ac0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 6f 73 (lambda (pos
2ad0: 20 61 72 67 6c 69 73 74 20 6c 61 73 74 2d 77 61 arglist last-wa
2ae0: 73 2d 6e 65 77 6c 69 6e 65 29 20 20 20 20 20 0a s-newline) .
2af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b00: 20 20 20 20 28 63 6f 6e 64 20 20 20 20 20 20 20 (cond
2b10: 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 .
2b20: 20 20 20 20 20 20 20 20 20 20 20 28 28 3e 3d 20 ((>=
2b30: 70 6f 73 20 6c 65 6e 67 74 68 2d 6f 66 2d 66 6f pos length-of-fo
2b40: 72 6d 61 74 2d 73 74 72 69 6e 67 29 20 20 20 0a rmat-string) .
2b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b60: 20 20 20 20 20 20 20 28 77 72 69 74 65 2d 63 68 (write-ch
2b70: 61 72 20 23 5c 7e 20 70 29 20 3b 20 74 69 6c 64 ar #\~ p) ; tild
2b80: 65 20 61 74 20 65 6e 64 20 6f 66 20 73 74 72 69 e at end of stri
2b90: 6e 67 20 69 73 20 6a 75 73 74 20 6f 75 74 70 75 ng is just outpu
2ba0: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
2bb0: 20 20 20 20 20 20 20 20 20 61 72 67 6c 69 73 74 arglist
2bc0: 20 3b 20 72 65 74 75 72 6e 20 75 6e 75 73 65 64 ; return unused
2bd0: 20 61 72 67 73 0a 20 20 20 20 20 20 20 20 20 20 args.
2be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 29 20 20 )
2bf0: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
2c00: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
2c10: 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 .
2c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 (ca
2c30: 73 65 20 28 63 68 61 72 2d 75 70 63 61 73 65 20 se (char-upcase
2c40: 28 73 74 72 69 6e 67 2d 72 65 66 20 66 6f 72 6d (string-ref form
2c50: 61 74 2d 73 74 72 67 20 70 6f 73 29 29 20 0a 20 at-strg pos)) .
2c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c70: 20 20 20 20 20 20 20 20 28 28 23 5c 41 29 20 20 ((#\A)
2c80: 20 20 20 20 20 3b 20 41 6e 79 20 2d 2d 20 66 6f ; Any -- fo
2c90: 72 20 68 75 6d 61 6e 73 0a 20 20 20 20 20 20 20 r humans.
2ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2cb0: 20 20 20 28 72 65 71 75 69 72 65 2d 61 6e 2d 61 (require-an-a
2cc0: 72 67 20 61 72 67 6c 69 73 74 29 0a 20 20 20 20 rg arglist).
2cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ce0: 20 20 20 20 20 20 28 6c 65 74 20 28 20 5b 77 68 (let ( [wh
2cf0: 61 74 65 76 65 72 20 28 63 61 72 20 61 72 67 6c atever (car argl
2d00: 69 73 74 29 5d 20 29 0a 20 20 20 20 20 20 20 20 ist)] ).
2d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d20: 20 20 20 20 28 64 69 73 70 6c 61 79 20 77 68 61 (display wha
2d30: 74 65 76 65 72 20 70 29 0a 20 20 20 20 20 20 20 tever p).
2d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d50: 20 20 20 20 20 28 61 6e 79 63 68 61 72 2d 64 69 (anychar-di
2d60: 73 70 61 74 63 68 20 28 2b 20 70 6f 73 20 31 29 spatch (+ pos 1)
2d70: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2da0: 28 63 64 72 20 61 72 67 6c 69 73 74 29 20 0a 20 (cdr arglist) .
2db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 61 (ha
2de0: 73 2d 6e 65 77 6c 69 6e 65 3f 20 77 68 61 74 65 s-newline? whate
2df0: 76 65 72 20 6c 61 73 74 2d 77 61 73 2d 6e 65 77 ver last-was-new
2e00: 6c 69 6e 65 29 29 0a 20 20 20 20 20 20 20 20 20 line)).
2e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e20: 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 )).
2e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2e40: 28 23 5c 53 29 20 20 20 20 20 20 20 3b 20 53 6c (#\S) ; Sl
2e50: 61 73 68 69 66 69 65 64 20 2d 2d 20 66 6f 72 20 ashified -- for
2e60: 70 61 72 73 65 72 73 0a 20 20 20 20 20 20 20 20 parsers.
2e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e80: 20 20 28 72 65 71 75 69 72 65 2d 61 6e 2d 61 72 (require-an-ar
2e90: 67 20 61 72 67 6c 69 73 74 29 0a 20 20 20 20 20 g arglist).
2ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2eb0: 20 20 20 20 20 28 6c 65 74 20 28 20 5b 77 68 61 (let ( [wha
2ec0: 74 65 76 65 72 20 28 63 61 72 20 61 72 67 6c 69 tever (car argli
2ed0: 73 74 29 5d 20 29 0a 20 20 20 20 20 20 20 20 20 st)] ).
2ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ef0: 20 20 20 28 77 72 69 74 65 20 77 68 61 74 65 76 (write whatev
2f00: 65 72 20 70 29 20 20 20 20 20 0a 20 20 20 20 20 er p) .
2f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f20: 20 20 20 20 20 20 20 28 61 6e 79 63 68 61 72 2d (anychar-
2f30: 64 69 73 70 61 74 63 68 20 28 2b 20 70 6f 73 20 dispatch (+ pos
2f40: 31 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 1) .
2f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f70: 20 20 28 63 64 72 20 61 72 67 6c 69 73 74 29 20 (cdr arglist)
2f80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2fb0: 68 61 73 2d 6e 65 77 6c 69 6e 65 3f 20 77 68 61 has-newline? wha
2fc0: 74 65 76 65 72 20 6c 61 73 74 2d 77 61 73 2d 6e tever last-was-n
2fd0: 65 77 6c 69 6e 65 29 29 20 0a 20 20 20 20 20 20 ewline)) .
2fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ff0: 20 20 20 20 20 20 29 29 0a 20 20 20 20 20 20 20 )).
3000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3010: 20 20 28 28 23 5c 57 29 0a 20 20 20 20 20 20 20 ((#\W).
3020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3030: 20 20 20 28 72 65 71 75 69 72 65 2d 61 6e 2d 61 (require-an-a
3040: 72 67 20 61 72 67 6c 69 73 74 29 0a 20 20 20 20 rg arglist).
3050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3060: 20 20 20 20 20 20 28 6c 65 74 20 28 20 5b 77 68 (let ( [wh
3070: 61 74 65 76 65 72 20 28 63 61 72 20 61 72 67 6c atever (car argl
3080: 69 73 74 29 5d 20 29 0a 20 20 20 20 20 20 20 20 ist)] ).
3090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30a0: 20 20 20 20 28 77 72 69 74 65 2d 77 69 74 68 2d (write-with-
30b0: 73 68 61 72 65 64 2d 73 74 72 75 63 74 75 72 65 shared-structure
30c0: 20 77 68 61 74 65 76 65 72 20 70 29 20 20 3b 3b whatever p) ;;
30d0: 20 73 72 66 69 2d 33 38 0a 20 20 20 20 20 20 20 srfi-38.
30e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30f0: 20 20 20 20 20 28 61 6e 79 63 68 61 72 2d 64 69 (anychar-di
3100: 73 70 61 74 63 68 20 28 2b 20 70 6f 73 20 31 29 spatch (+ pos 1)
3110: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3140: 28 63 64 72 20 61 72 67 6c 69 73 74 29 20 0a 20 (cdr arglist) .
3150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3170: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 61 (ha
3180: 73 2d 6e 65 77 6c 69 6e 65 3f 20 77 68 61 74 65 s-newline? whate
3190: 76 65 72 20 6c 61 73 74 2d 77 61 73 2d 6e 65 77 ver last-was-new
31a0: 6c 69 6e 65 29 29 0a 20 20 20 20 20 20 20 20 20 line)).
31b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31c0: 20 20 20 29 29 20 20 20 20 20 20 20 20 20 20 20 ))
31d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
31e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
31f0: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 44 29 ((#\D)
3200: 20 20 20 20 20 20 20 3b 20 44 65 63 69 6d 61 6c ; Decimal
3210: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3220: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 71 75 (requ
3230: 69 72 65 2d 61 6e 2d 61 72 67 20 61 72 67 6c 69 ire-an-arg argli
3240: 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 st).
3250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
3260: 69 73 70 6c 61 79 20 28 6e 75 6d 62 65 72 2d 3e isplay (number->
3270: 73 74 72 69 6e 67 20 28 63 61 72 20 61 72 67 6c string (car argl
3280: 69 73 74 29 20 31 30 29 20 70 29 20 20 0a 20 20 ist) 10) p) .
3290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
32a0: 20 20 20 20 20 20 20 20 28 61 6e 79 63 68 61 72 (anychar
32b0: 2d 64 69 73 70 61 74 63 68 20 28 2b 20 70 6f 73 -dispatch (+ pos
32c0: 20 31 29 20 28 63 64 72 20 61 72 67 6c 69 73 74 1) (cdr arglist
32d0: 29 20 23 66 29 20 20 0a 20 20 20 20 20 20 20 20 ) #f) .
32e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
32f0: 20 20 29 20 20 20 20 20 20 20 20 20 20 20 20 0a ) .
3300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3310: 20 20 20 20 20 20 20 20 20 28 28 23 5c 58 29 20 ((#\X)
3320: 20 20 20 20 20 20 3b 20 48 65 58 61 64 65 63 69 ; HeXadeci
3330: 6d 61 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 mal.
3340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
3350: 65 71 75 69 72 65 2d 61 6e 2d 61 72 67 20 61 72 equire-an-arg ar
3360: 67 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 glist).
3370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3380: 20 28 64 69 73 70 6c 61 79 20 28 6e 75 6d 62 65 (display (numbe
3390: 72 2d 3e 73 74 72 69 6e 67 20 28 63 61 72 20 61 r->string (car a
33a0: 72 67 6c 69 73 74 29 20 31 36 29 20 70 29 0a 20 rglist) 16) p).
33b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33c0: 20 20 20 20 20 20 20 20 20 28 61 6e 79 63 68 61 (anycha
33d0: 72 2d 64 69 73 70 61 74 63 68 20 28 2b 20 70 6f r-dispatch (+ po
33e0: 73 20 31 29 20 28 63 64 72 20 61 72 67 6c 69 73 s 1) (cdr arglis
33f0: 74 29 20 23 66 29 20 20 0a 20 20 20 20 20 20 20 t) #f) .
3400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3410: 20 20 20 29 20 20 20 20 20 20 20 20 20 20 20 20 )
3420: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3430: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 4f ((#\O
3440: 29 20 20 20 20 20 20 20 3b 20 4f 63 74 61 6c 0a ) ; Octal.
3450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3460: 20 20 20 20 20 20 20 20 20 20 28 72 65 71 75 69 (requi
3470: 72 65 2d 61 6e 2d 61 72 67 20 61 72 67 6c 69 73 re-an-arg arglis
3480: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
3490: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 69 (di
34a0: 73 70 6c 61 79 20 28 6e 75 6d 62 65 72 2d 3e 73 splay (number->s
34b0: 74 72 69 6e 67 20 28 63 61 72 20 61 72 67 6c 69 tring (car argli
34c0: 73 74 29 20 20 38 29 20 70 29 20 0a 20 20 20 20 st) 8) p) .
34d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34e0: 20 20 20 20 20 20 28 61 6e 79 63 68 61 72 2d 64 (anychar-d
34f0: 69 73 70 61 74 63 68 20 28 2b 20 70 6f 73 20 31 ispatch (+ pos 1
3500: 29 20 28 63 64 72 20 61 72 67 6c 69 73 74 29 20 ) (cdr arglist)
3510: 23 66 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 #f) .
3520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 )
3530: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
3540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3550: 20 28 28 23 5c 42 29 20 20 20 20 20 20 20 3b 20 ((#\B) ;
3560: 42 69 6e 61 72 79 0a 20 20 20 20 20 20 20 20 20 Binary.
3570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3580: 20 28 72 65 71 75 69 72 65 2d 61 6e 2d 61 72 67 (require-an-arg
3590: 20 61 72 67 6c 69 73 74 29 0a 20 20 20 20 20 20 arglist).
35a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
35b0: 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 6e 75 (display (nu
35c0: 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 28 63 61 mber->string (ca
35d0: 72 20 61 72 67 6c 69 73 74 29 20 20 32 29 20 70 r arglist) 2) p
35e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
35f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 79 (any
3600: 63 68 61 72 2d 64 69 73 70 61 74 63 68 20 28 2b char-dispatch (+
3610: 20 70 6f 73 20 31 29 20 28 63 64 72 20 61 72 67 pos 1) (cdr arg
3620: 6c 69 73 74 29 20 23 66 29 20 0a 20 20 20 20 20 list) #f) .
3630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3640: 20 20 20 20 20 29 20 20 20 20 20 20 20 20 20 20 )
3650: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3660: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 43 ((#\C
3670: 29 20 20 20 20 20 20 20 3b 20 43 68 61 72 61 63 ) ; Charac
3680: 74 65 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 ter.
3690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
36a0: 65 71 75 69 72 65 2d 61 6e 2d 61 72 67 20 61 72 equire-an-arg ar
36b0: 67 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 glist).
36c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
36d0: 20 28 77 72 69 74 65 2d 63 68 61 72 20 28 63 61 (write-char (ca
36e0: 72 20 61 72 67 6c 69 73 74 29 20 70 29 20 0a 20 r arglist) p) .
36f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3700: 20 20 20 20 20 20 20 20 20 28 61 6e 79 63 68 61 (anycha
3710: 72 2d 64 69 73 70 61 74 63 68 20 28 2b 20 70 6f r-dispatch (+ po
3720: 73 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 s 1).
3730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3750: 20 28 63 64 72 20 61 72 67 6c 69 73 74 29 0a 20 (cdr arglist).
3760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3780: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 76 3f (eqv?
3790: 20 28 63 61 72 20 61 72 67 6c 69 73 74 29 20 23 (car arglist) #
37a0: 5c 6e 65 77 6c 69 6e 65 29 29 20 20 0a 20 20 20 \newline)) .
37b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
37c0: 20 20 20 20 20 20 20 29 20 20 20 20 20 20 20 20 )
37d0: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
37e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c ((#\
37f0: 7e 29 20 20 20 20 20 20 20 3b 20 54 69 6c 64 65 ~) ; Tilde
3800: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3810: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 77 72 (wr
3820: 69 74 65 2d 63 68 61 72 20 23 5c 7e 20 70 29 20 ite-char #\~ p)
3830: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3840: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
3850: 79 63 68 61 72 2d 64 69 73 70 61 74 63 68 20 28 ychar-dispatch (
3860: 2b 20 70 6f 73 20 31 29 20 61 72 67 6c 69 73 74 + pos 1) arglist
3870: 20 23 66 29 20 0a 20 20 20 20 20 20 20 20 20 20 #f) .
3880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3890: 29 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 ) .
38a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38b0: 20 20 20 20 20 20 20 28 28 23 5c 25 29 20 20 20 ((#\%)
38c0: 20 20 20 20 3b 20 4e 65 77 6c 69 6e 65 20 20 20 ; Newline
38d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
38e0: 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 77 6c (newl
38f0: 69 6e 65 20 70 29 20 0a 20 20 20 20 20 20 20 20 ine p) .
3900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3910: 20 20 28 61 6e 79 63 68 61 72 2d 64 69 73 70 61 (anychar-dispa
3920: 74 63 68 20 28 2b 20 70 6f 73 20 31 29 20 61 72 tch (+ pos 1) ar
3930: 67 6c 69 73 74 20 23 74 29 20 0a 20 20 20 20 20 glist #t) .
3940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3950: 20 20 20 20 20 29 0a 20 20 20 20 20 20 20 20 20 ).
3960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3970: 28 28 23 5c 26 29 20 20 20 20 20 20 3b 20 46 72 ((#\&) ; Fr
3980: 65 73 68 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 eshline.
3990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39a0: 20 20 28 69 66 20 28 6e 6f 74 20 6c 61 73 74 2d (if (not last-
39b0: 77 61 73 2d 6e 65 77 6c 69 6e 65 29 20 3b 3b 20 was-newline) ;;
39c0: 28 75 6e 6c 65 73 73 20 6c 61 73 74 2d 77 61 73 (unless last-was
39d0: 2d 6e 65 77 6c 69 6e 65 20 2e 2e 0a 20 20 20 20 -newline ...
39e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39f0: 20 20 20 20 20 20 20 20 28 6e 65 77 6c 69 6e 65 (newline
3a00: 20 70 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 p)).
3a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3a20: 61 6e 79 63 68 61 72 2d 64 69 73 70 61 74 63 68 anychar-dispatch
3a30: 20 28 2b 20 70 6f 73 20 31 29 20 61 72 67 6c 69 (+ pos 1) argli
3a40: 73 74 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 st #t).
3a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a60: 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3a70: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c ((#\
3a80: 5f 29 20 20 20 20 20 20 20 3b 20 53 70 61 63 65 _) ; Space
3a90: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3aa0: 20 20 20 20 20 20 20 20 20 20 20 20 28 77 72 69 (wri
3ab0: 74 65 2d 63 68 61 72 20 23 5c 73 70 61 63 65 20 te-char #\space
3ac0: 70 29 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 p) .
3ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ae0: 28 61 6e 79 63 68 61 72 2d 64 69 73 70 61 74 63 (anychar-dispatc
3af0: 68 20 28 2b 20 70 6f 73 20 31 29 20 61 72 67 6c h (+ pos 1) argl
3b00: 69 73 74 20 23 66 29 0a 20 20 20 20 20 20 20 20 ist #f).
3b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b20: 20 20 29 20 20 20 20 20 20 20 20 20 20 20 20 20 )
3b30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3b40: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 54 29 ((#\T)
3b50: 20 20 20 20 20 20 20 3b 20 54 61 62 20 2d 2d 20 ; Tab --
3b60: 49 4d 50 4c 45 4d 45 4e 54 41 54 49 4f 4e 20 44 IMPLEMENTATION D
3b70: 45 50 45 4e 44 45 4e 54 20 45 4e 43 4f 44 49 4e EPENDENT ENCODIN
3b80: 47 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 G .
3b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ba0: 28 77 72 69 74 65 2d 63 68 61 72 20 61 73 63 69 (write-char asci
3bb0: 69 2d 74 61 62 20 70 29 20 20 20 20 20 20 20 20 i-tab p)
3bc0: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
3be0: 79 63 68 61 72 2d 64 69 73 70 61 74 63 68 20 28 ychar-dispatch (
3bf0: 2b 20 70 6f 73 20 31 29 20 61 72 67 6c 69 73 74 + pos 1) arglist
3c00: 20 23 66 29 20 20 20 20 20 0a 20 20 20 20 20 20 #f) .
3c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c20: 20 20 20 20 29 20 20 20 20 20 20 20 20 20 20 20 )
3c30: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3c40: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c ((#\
3c50: 59 29 20 20 20 20 20 20 20 3b 20 50 72 65 74 74 Y) ; Prett
3c60: 79 2d 70 72 69 6e 74 0a 20 20 20 20 20 20 20 20 y-print.
3c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c80: 20 20 28 70 72 65 74 74 79 2d 70 72 69 6e 74 20 (pretty-print
3c90: 28 63 61 72 20 61 72 67 6c 69 73 74 29 20 70 29 (car arglist) p)
3ca0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3cb0: 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 79 63 (anyc
3cc0: 68 61 72 2d 64 69 73 70 61 74 63 68 20 28 2b 20 har-dispatch (+
3cd0: 70 6f 73 20 31 29 20 28 63 64 72 20 61 72 67 6c pos 1) (cdr argl
3ce0: 69 73 74 29 20 23 66 29 0a 20 20 20 20 20 20 20 ist) #f).
3cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d00: 20 20 20 29 20 20 20 20 20 20 20 20 20 20 20 20 )
3d10: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3d20: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c ((#\
3d30: 46 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 F).
3d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
3d50: 71 75 69 72 65 2d 61 6e 2d 61 72 67 20 61 72 67 quire-an-arg arg
3d60: 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 list).
3d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d80: 28 64 69 73 70 6c 61 79 20 28 66 6f 72 6d 61 74 (display (format
3d90: 2d 66 69 78 65 64 20 28 63 61 72 20 61 72 67 6c -fixed (car argl
3da0: 69 73 74 29 20 30 20 23 66 29 20 70 29 0a 20 20 ist) 0 #f) p).
3db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3dc0: 20 20 20 20 20 20 20 20 28 61 6e 79 63 68 61 72 (anychar
3dd0: 2d 64 69 73 70 61 74 63 68 20 28 2b 20 70 6f 73 -dispatch (+ pos
3de0: 20 31 29 20 28 63 64 72 20 61 72 67 6c 69 73 74 1) (cdr arglist
3df0: 29 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 ) #f).
3e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3e20: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 30 ((#\0
3e30: 20 23 5c 31 20 23 5c 32 20 23 5c 33 20 23 5c 34 #\1 #\2 #\3 #\4
3e40: 20 23 5c 35 20 23 5c 36 20 23 5c 37 20 23 5c 38 #\5 #\6 #\7 #\8
3e50: 20 23 5c 39 29 0a 20 20 20 20 20 20 20 20 20 20 #\9).
3e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e70: 3b 3b 20 67 61 74 68 65 72 20 22 7e 77 5b 2c 64 ;; gather "~w[,d
3e80: 5d 46 22 20 77 20 61 6e 64 20 64 20 64 69 67 69 ]F" w and d digi
3e90: 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ts.
3ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
3eb0: 74 20 6c 6f 6f 70 20 28 20 5b 69 6e 64 65 78 20 t loop ( [index
3ec0: 28 2b 20 70 6f 73 20 31 29 5d 0a 20 20 20 20 20 (+ pos 1)].
3ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ef0: 20 5b 77 2d 64 69 67 69 74 73 20 28 6c 69 73 74 [w-digits (list
3f00: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 66 6f 72 (string-ref for
3f10: 6d 61 74 2d 73 74 72 67 20 70 6f 73 29 29 5d 0a mat-strg pos))].
3f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f40: 20 20 20 20 20 20 5b 64 2d 64 69 67 69 74 73 20 [d-digits
3f50: 27 28 29 5d 0a 20 20 20 20 20 20 20 20 20 20 20 '()].
3f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f70: 20 20 20 20 20 20 20 20 20 20 20 5b 69 6e 2d 77 [in-w
3f80: 69 64 74 68 3f 20 23 74 5d 0a 20 20 20 20 20 20 idth? #t].
3f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fb0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
3fd0: 66 20 28 3e 3d 20 69 6e 64 65 78 20 6c 65 6e 67 f (>= index leng
3fe0: 74 68 2d 6f 66 2d 66 6f 72 6d 61 74 2d 73 74 72 th-of-format-str
3ff0: 69 6e 67 29 0a 20 20 20 20 20 20 20 20 20 20 20 ing).
4000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4010: 20 20 20 28 70 72 6f 62 6c 65 6d 20 22 69 6d 70 (problem "imp
4020: 72 6f 70 65 72 20 6e 75 6d 65 72 69 63 20 66 6f roper numeric fo
4030: 72 6d 61 74 20 64 69 72 65 63 74 69 76 65 22 20 rmat directive"
4040: 66 6f 72 6d 61 74 2d 73 74 72 67 29 0a 20 20 20 format-strg).
4050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4060: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
4070: 28 20 5b 6e 65 78 74 2d 63 68 61 72 20 28 73 74 ( [next-char (st
4080: 72 69 6e 67 2d 72 65 66 20 66 6f 72 6d 61 74 2d ring-ref format-
4090: 73 74 72 67 20 69 6e 64 65 78 29 5d 20 29 0a 20 strg index)] ).
40a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
40c0: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
40d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40e0: 20 20 20 20 20 20 20 5b 28 63 68 61 72 2d 6e 75 [(char-nu
40f0: 6d 65 72 69 63 3f 20 6e 65 78 74 2d 63 68 61 72 meric? next-char
4100: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4120: 20 20 20 20 20 28 69 66 20 69 6e 2d 77 69 64 74 (if in-widt
4130: 68 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 h?.
4140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4150: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 2b (loop (+
4160: 20 69 6e 64 65 78 20 31 29 0a 20 20 20 20 20 20 index 1).
4170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4190: 20 20 20 20 20 28 63 6f 6e 73 20 6e 65 78 74 2d (cons next-
41a0: 63 68 61 72 20 77 2d 64 69 67 69 74 73 29 0a 20 char w-digits).
41b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41d0: 20 20 20 20 20 20 20 20 20 20 64 2d 64 69 67 69 d-digi
41e0: 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ts.
41f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e in
4210: 2d 77 69 64 74 68 3f 29 0a 20 20 20 20 20 20 20 -width?).
4220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
4240: 6f 6f 70 20 28 2b 20 69 6e 64 65 78 20 31 29 0a oop (+ index 1).
4250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4270: 20 20 20 20 20 20 20 20 20 20 20 77 2d 64 69 67 w-dig
4280: 69 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 its.
4290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
42b0: 63 6f 6e 73 20 6e 65 78 74 2d 63 68 61 72 20 64 cons next-char d
42c0: 2d 64 69 67 69 74 73 29 0a 20 20 20 20 20 20 20 -digits).
42d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42f0: 20 20 20 20 69 6e 2d 77 69 64 74 68 3f 29 29 0a in-width?)).
4300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4320: 20 20 20 5d 0a 20 20 20 20 20 20 20 20 20 20 20 ].
4330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4340: 20 20 20 20 20 20 20 5b 28 63 68 61 72 3d 3f 20 [(char=?
4350: 28 63 68 61 72 2d 75 70 63 61 73 65 20 6e 65 78 (char-upcase nex
4360: 74 2d 63 68 61 72 29 20 23 5c 46 29 0a 20 20 20 t-char) #\F).
4370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4390: 28 6c 65 74 20 28 20 5b 77 69 64 74 68 0a 20 20 (let ( [width.
43a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43c0: 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
43d0: 2d 3e 6e 75 6d 62 65 72 0a 20 20 20 20 20 20 20 ->number.
43e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4400: 20 20 20 20 20 28 6c 69 73 74 2d 3e 73 74 72 69 (list->stri
4410: 6e 67 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ng.
4420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4440: 28 72 65 76 65 72 73 65 20 77 2d 64 69 67 69 74 (reverse w-digit
4450: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
4460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4480: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ].
4490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44a0: 20 20 20 20 20 20 20 20 20 20 20 20 5b 64 69 67 [dig
44b0: 69 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 its.
44c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
44e0: 69 66 20 28 7a 65 72 6f 3f 20 28 6c 65 6e 67 74 if (zero? (lengt
44f0: 68 20 64 2d 64 69 67 69 74 73 29 29 0a 20 20 20 h d-digits)).
4500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4520: 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 20 20 #f.
4530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4550: 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e (strin
4560: 67 2d 3e 6e 75 6d 62 65 72 0a 20 20 20 20 20 20 g->number.
4570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4590: 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d 3e 73 (list->s
45a0: 74 72 69 6e 67 20 28 72 65 76 65 72 73 65 20 64 tring (reverse d
45b0: 2d 64 69 67 69 74 73 29 29 29 29 5d 0a 20 20 20 -digits))))].
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45e0: 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 20 ).
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
4610: 69 73 70 6c 61 79 0a 20 20 20 20 20 20 20 20 20 isplay.
4620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4630: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6f (fo
4640: 72 6d 61 74 2d 66 69 78 65 64 20 28 63 61 72 20 rmat-fixed (car
4650: 61 72 67 6c 69 73 74 29 20 77 69 64 74 68 20 64 arglist) width d
4660: 69 67 69 74 73 29 0a 20 20 20 20 20 20 20 20 20 igits).
4670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4680: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 29 0a p).
4690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46b0: 20 20 20 20 20 28 61 6e 79 63 68 61 72 2d 64 69 (anychar-di
46c0: 73 70 61 74 63 68 20 28 2b 20 69 6e 64 65 78 20 spatch (+ index
46d0: 31 29 20 28 63 64 72 20 61 72 67 6c 69 73 74 29 1) (cdr arglist)
46e0: 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 #f)).
46f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4700: 20 20 20 20 20 20 20 20 20 5d 0a 20 20 20 20 20 ].
4710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4720: 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 28 63 [(c
4730: 68 61 72 3d 3f 20 6e 65 78 74 2d 63 68 61 72 20 har=? next-char
4740: 23 5c 2c 29 0a 20 20 20 20 20 20 20 20 20 20 20 #\,).
4750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4760: 20 20 20 20 20 20 20 20 28 69 66 20 69 6e 2d 77 (if in-w
4770: 69 64 74 68 3f 0a 20 20 20 20 20 20 20 20 20 20 idth?.
4780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4790: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
47a0: 20 28 2b 20 69 6e 64 65 78 20 31 29 0a 20 20 20 (+ index 1).
47b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47d0: 20 20 20 20 20 20 20 20 77 2d 64 69 67 69 74 73 w-digits
47e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
47f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4800: 20 20 20 20 20 20 20 20 20 20 20 20 64 2d 64 69 d-di
4810: 67 69 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 gits.
4820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4840: 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 #f).
4850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4860: 20 20 20 20 20 20 20 20 20 28 70 72 6f 62 6c 65 (proble
4870: 6d 20 22 74 6f 6f 20 6d 61 6e 79 20 63 6f 6d 6d m "too many comm
4880: 61 73 20 69 6e 20 64 69 72 65 63 74 69 76 65 22 as in directive"
4890: 20 66 6f 72 6d 61 74 2d 73 74 72 67 29 29 0a 20 format-strg)).
48a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48c0: 20 20 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 ].
48d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48e0: 20 20 20 20 20 20 5b 65 6c 73 65 0a 20 20 20 20 [else.
48f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4910: 70 72 6f 62 6c 65 6d 20 22 7e 77 2c 64 46 20 64 problem "~w,dF d
4920: 69 72 65 63 74 69 76 65 20 69 6c 6c 2d 66 6f 72 irective ill-for
4930: 6d 65 64 22 20 66 6f 72 6d 61 74 2d 73 74 72 67 med" format-strg
4940: 29 5d 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 )]))).
4950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4960: 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )).
4970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
4980: 23 5c 3f 20 23 5c 4b 29 20 20 20 20 20 20 20 3b #\? #\K) ;
4990: 20 69 6e 64 69 72 65 63 74 69 6f 6e 20 2d 2d 20 indirection --
49a0: 74 61 6b 65 20 6e 65 78 74 20 61 72 67 20 61 73 take next arg as
49b0: 20 66 6f 72 6d 61 74 20 73 74 72 69 6e 67 0a 20 format string.
49c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49d0: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 20 20 (cond
49e0: 20 20 20 20 20 20 20 20 20 3b 20 20 61 6e 64 20 ; and
49f0: 66 6f 6c 6c 6f 77 69 6e 67 20 61 72 67 20 61 73 following arg as
4a00: 20 6c 69 73 74 20 6f 66 20 66 6f 72 6d 61 74 20 list of format
4a10: 61 72 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 args.
4a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a30: 20 28 28 3c 20 28 6c 65 6e 67 74 68 20 61 72 67 ((< (length arg
4a40: 6c 69 73 74 29 20 32 29 0a 20 20 20 20 20 20 20 list) 2).
4a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a60: 20 20 20 20 20 20 28 70 72 6f 62 6c 65 6d 20 22 (problem "
4a70: 6c 65 73 73 20 61 72 67 75 6d 65 6e 74 73 20 74 less arguments t
4a80: 68 61 6e 20 73 70 65 63 69 66 69 65 64 20 66 6f han specified fo
4a90: 72 20 7e 3f 22 20 61 72 67 6c 69 73 74 29 0a 20 r ~?" arglist).
4aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ab0: 20 20 20 20 20 20 20 20 20 20 20 20 29 0a 20 20 ).
4ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ad0: 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 ((not
4ae0: 28 73 74 72 69 6e 67 3f 20 28 63 61 72 20 61 72 (string? (car ar
4af0: 67 6c 69 73 74 29 29 29 0a 20 20 20 20 20 20 20 glist))).
4b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b10: 20 20 20 20 20 20 28 70 72 6f 62 6c 65 6d 20 22 (problem "
4b20: 7e 3f 20 72 65 71 75 69 72 65 73 20 61 20 73 74 ~? requires a st
4b30: 72 69 6e 67 22 20 28 63 61 72 20 61 72 67 6c 69 ring" (car argli
4b40: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
4b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b60: 20 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ).
4b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b80: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
4b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ba0: 20 20 20 28 66 6f 72 6d 61 74 2d 68 65 6c 70 20 (format-help
4bb0: 70 20 28 63 61 72 20 61 72 67 6c 69 73 74 29 20 p (car arglist)
4bc0: 28 63 61 64 72 20 61 72 67 6c 69 73 74 29 29 0a (cadr arglist)).
4bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
4bf0: 79 63 68 61 72 2d 64 69 73 70 61 74 63 68 20 28 ychar-dispatch (
4c00: 2b 20 70 6f 73 20 31 29 20 28 63 64 64 72 20 61 + pos 1) (cddr a
4c10: 72 67 6c 69 73 74 29 20 23 66 29 0a 20 20 20 20 rglist) #f).
4c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c30: 20 20 20 20 20 20 20 20 20 29 29 29 0a 20 20 20 ))).
4c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c50: 20 20 20 20 20 20 28 28 23 5c 48 29 20 20 20 20 ((#\H)
4c60: 20 20 3b 20 48 65 6c 70 0a 20 20 20 20 20 20 20 ; Help.
4c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c80: 20 20 20 28 64 69 73 70 6c 61 79 20 64 6f 63 75 (display docu
4c90: 6d 65 6e 74 61 74 69 6f 6e 2d 73 74 72 69 6e 67 mentation-string
4ca0: 20 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 p).
4cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
4cc0: 6e 79 63 68 61 72 2d 64 69 73 70 61 74 63 68 20 nychar-dispatch
4cd0: 28 2b 20 70 6f 73 20 31 29 20 61 72 67 6c 69 73 (+ pos 1) arglis
4ce0: 74 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 t #t).
4cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d00: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4d10: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else
4d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4d40: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 6f 62 (prob
4d50: 6c 65 6d 20 22 75 6e 6b 6e 6f 77 6e 20 74 69 6c lem "unknown til
4d60: 64 65 20 65 73 63 61 70 65 22 20 28 73 74 72 69 de escape" (stri
4d70: 6e 67 2d 72 65 66 20 66 6f 72 6d 61 74 2d 73 74 ng-ref format-st
4d80: 72 67 20 70 6f 73 29 29 29 0a 20 20 20 20 20 20 rg pos))).
4d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4da0: 20 20 20 29 29 29 0a 20 20 20 20 20 20 20 20 20 ))).
4db0: 20 20 20 20 20 20 20 20 20 20 20 29 5d 20 3b 20 )] ;
4dc0: 65 6e 64 20 74 69 6c 64 65 2d 64 69 73 70 61 74 end tilde-dispat
4dd0: 63 68 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 ch .
4de0: 20 20 20 20 20 20 20 29 20 3b 20 65 6e 64 20 6c ) ; end l
4df0: 65 74 72 65 63 20 20 20 20 20 20 20 20 20 20 20 etrec
4e00: 20 0a 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 . .
4e10: 20 20 20 20 20 20 20 3b 20 66 6f 72 6d 61 74 2d ; format-
4e20: 68 65 6c 70 20 62 6f 64 79 0a 20 20 20 20 20 20 help body.
4e30: 20 20 20 20 28 61 6e 79 63 68 61 72 2d 64 69 73 (anychar-dis
4e40: 70 61 74 63 68 20 30 20 61 72 67 6c 69 73 74 20 patch 0 arglist
4e50: 23 66 29 20 0a 20 20 20 20 20 20 20 20 20 20 29 #f) . )
4e60: 29 20 3b 20 65 6e 64 20 66 6f 72 6d 61 74 2d 68 ) ; end format-h
4e70: 65 6c 70 20 20 20 20 0a 20 20 20 20 20 20 0a 20 elp . .
4e80: 20 20 20 20 20 3b 20 5f 66 6f 72 6d 61 74 20 62 ; _format b
4e90: 6f 64 79 0a 20 20 20 20 20 20 28 6c 65 74 20 28 ody. (let (
4ea0: 20 5b 75 6e 75 73 65 64 2d 61 72 67 73 20 28 66 [unused-args (f
4eb0: 6f 72 6d 61 74 2d 68 65 6c 70 20 70 6f 72 74 20 ormat-help port
4ec0: 66 6f 72 6d 61 74 2d 73 74 72 69 6e 67 20 61 72 format-string ar
4ed0: 67 73 29 5d 20 29 0a 20 20 20 20 20 20 20 20 28 gs)] ). (
4ee0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 75 if (not (null? u
4ef0: 6e 75 73 65 64 2d 61 72 67 73 29 29 0a 20 20 20 nused-args)).
4f00: 20 20 20 20 20 20 20 28 70 72 6f 62 6c 65 6d 20 (problem
4f10: 22 75 6e 75 73 65 64 20 61 72 67 75 6d 65 6e 74 "unused argument
4f20: 73 22 20 75 6e 75 73 65 64 2d 61 72 67 73 29 0a s" unused-args).
4f30: 20 20 20 20 20 20 20 20 20 20 28 72 65 74 75 72 (retur
4f40: 6e 2d 76 61 6c 75 65 20 70 6f 72 74 29 29 29 29 n-value port))))
4f50: 0a 20 20 20 20 0a 20 20 20 20 3b 20 66 6f 72 6d . . ; form
4f60: 61 74 20 62 6f 64 79 0a 20 20 20 20 28 69 66 20 at body. (if
4f70: 28 73 74 72 69 6e 67 3f 20 61 72 67 30 29 0a 20 (string? arg0).
4f80: 20 20 20 20 20 28 5f 66 6f 72 6d 61 74 20 28 6f (_format (o
4f90: 70 65 6e 2d 6f 75 74 70 75 74 2d 73 74 72 69 6e pen-output-strin
4fa0: 67 29 20 61 72 67 30 20 61 72 67 2a 20 67 65 74 g) arg0 arg* get
4fb0: 2d 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 29 0a -output-string).
4fc0: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null?
4fd0: 20 61 72 67 2a 29 0a 20 20 20 20 20 20 20 20 28 arg*). (
4fe0: 70 72 6f 62 6c 65 6d 20 22 74 6f 6f 20 66 65 77 problem "too few
4ff0: 20 61 72 67 75 6d 65 6e 74 73 22 20 28 6c 69 73 arguments" (lis
5000: 74 20 61 72 67 30 29 29 0a 20 20 20 20 20 20 20 t arg0)).
5010: 20 28 6c 65 74 20 28 5b 70 6f 72 74 20 28 63 6f (let ([port (co
5020: 6e 64 20 5b 28 65 71 3f 20 61 72 67 30 20 23 66 nd [(eq? arg0 #f
5030: 29 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 73 ) (open-output-s
5040: 74 72 69 6e 67 29 5d 0a 20 20 20 20 20 20 20 20 tring)].
5050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5060: 20 20 5b 28 65 71 3f 20 61 72 67 30 20 23 74 29 [(eq? arg0 #t)
5070: 20 28 63 75 72 72 65 6e 74 2d 6f 75 74 70 75 74 (current-output
5080: 2d 70 6f 72 74 29 5d 0a 20 20 20 20 20 20 20 20 -port)].
5090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50a0: 20 20 5b 28 6f 75 74 70 75 74 2d 70 6f 72 74 3f [(output-port?
50b0: 20 61 72 67 30 29 20 61 72 67 30 5d 0a 20 20 20 arg0) arg0].
50c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50d0: 20 20 20 20 20 20 20 5b 65 6c 73 65 20 28 70 72 [else (pr
50e0: 6f 62 6c 65 6d 20 22 62 61 64 20 6f 75 74 70 75 oblem "bad outpu
50f0: 74 2d 70 6f 72 74 20 61 72 67 75 6d 65 6e 74 22 t-port argument"
5100: 20 61 72 67 30 29 5d 29 5d 0a 20 20 20 20 20 20 arg0)])].
5110: 20 20 20 20 20 20 20 20 5b 61 72 67 31 20 28 63 [arg1 (c
5120: 61 72 20 61 72 67 2a 29 5d 29 0a 20 20 20 20 20 ar arg*)]).
5130: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
5140: 3f 20 61 72 67 31 29 0a 20 20 20 20 20 20 20 20 ? arg1).
5150: 20 20 20 20 28 5f 66 6f 72 6d 61 74 20 70 6f 72 (_format por
5160: 74 20 61 72 67 31 20 28 63 64 72 20 61 72 67 2a t arg1 (cdr arg*
5170: 29 20 28 69 66 20 61 72 67 30 20 28 6c 61 6d 62 ) (if arg0 (lamb
5180: 64 61 20 28 69 67 6e 6f 72 65 29 20 28 76 61 6c da (ignore) (val
5190: 75 65 73 29 29 20 67 65 74 2d 6f 75 74 70 75 74 ues)) get-output
51a0: 2d 73 74 72 69 6e 67 29 29 0a 20 20 20 20 20 20 -string)).
51b0: 20 20 20 20 20 20 28 70 72 6f 62 6c 65 6d 20 22 (problem "
51c0: 6e 6f 74 20 61 20 73 74 72 69 6e 67 22 20 61 72 not a string" ar
51d0: 67 31 29 29 29 29 29 29 20 0a 29 0a g1)))))) .).