Artifact
6a4337b3c3a0af58f07c0895b56c9d11175d25cd:
0000: 3b 3b 3b 20 61 72 67 73 2d 66 6f 6c 64 2e 73 63 ;;; args-fold.sc
0010: 6d 20 2d 20 61 20 70 72 6f 67 72 61 6d 20 61 72 m - a program ar
0020: 67 75 6d 65 6e 74 20 70 72 6f 63 65 73 73 6f 72 gument processor
0030: 0a 3b 3b 3b 0a 3b 3b 3b 20 43 6f 70 79 72 69 67 .;;;.;;; Copyrig
0040: 68 74 20 28 63 29 20 32 30 30 32 20 41 6e 74 68 ht (c) 2002 Anth
0050: 6f 6e 79 20 43 61 72 72 69 63 6f 0a 3b 3b 3b 0a ony Carrico.;;;.
0060: 3b 3b 3b 20 41 6c 6c 20 72 69 67 68 74 73 20 72 ;;; All rights r
0070: 65 73 65 72 76 65 64 2e 0a 3b 3b 3b 0a 3b 3b 3b eserved..;;;.;;;
0080: 20 52 65 64 69 73 74 72 69 62 75 74 69 6f 6e 20 Redistribution
0090: 61 6e 64 20 75 73 65 20 69 6e 20 73 6f 75 72 63 and use in sourc
00a0: 65 20 61 6e 64 20 62 69 6e 61 72 79 20 66 6f 72 e and binary for
00b0: 6d 73 2c 20 77 69 74 68 20 6f 72 20 77 69 74 68 ms, with or with
00c0: 6f 75 74 0a 3b 3b 3b 20 6d 6f 64 69 66 69 63 61 out.;;; modifica
00d0: 74 69 6f 6e 2c 20 61 72 65 20 70 65 72 6d 69 74 tion, are permit
00e0: 74 65 64 20 70 72 6f 76 69 64 65 64 20 74 68 61 ted provided tha
00f0: 74 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 t the following
0100: 63 6f 6e 64 69 74 69 6f 6e 73 0a 3b 3b 3b 20 61 conditions.;;; a
0110: 72 65 20 6d 65 74 3a 0a 3b 3b 3b 20 31 2e 20 52 re met:.;;; 1. R
0120: 65 64 69 73 74 72 69 62 75 74 69 6f 6e 73 20 6f edistributions o
0130: 66 20 73 6f 75 72 63 65 20 63 6f 64 65 20 6d 75 f source code mu
0140: 73 74 20 72 65 74 61 69 6e 20 74 68 65 20 61 62 st retain the ab
0150: 6f 76 65 20 63 6f 70 79 72 69 67 68 74 0a 3b 3b ove copyright.;;
0160: 3b 20 20 20 20 6e 6f 74 69 63 65 2c 20 74 68 69 ; notice, thi
0170: 73 20 6c 69 73 74 20 6f 66 20 63 6f 6e 64 69 74 s list of condit
0180: 69 6f 6e 73 20 61 6e 64 20 74 68 65 20 66 6f 6c ions and the fol
0190: 6c 6f 77 69 6e 67 20 64 69 73 63 6c 61 69 6d 65 lowing disclaime
01a0: 72 2e 0a 3b 3b 3b 20 32 2e 20 52 65 64 69 73 74 r..;;; 2. Redist
01b0: 72 69 62 75 74 69 6f 6e 73 20 69 6e 20 62 69 6e ributions in bin
01c0: 61 72 79 20 66 6f 72 6d 20 6d 75 73 74 20 72 65 ary form must re
01d0: 70 72 6f 64 75 63 65 20 74 68 65 20 61 62 6f 76 produce the abov
01e0: 65 20 63 6f 70 79 72 69 67 68 74 0a 3b 3b 3b 20 e copyright.;;;
01f0: 20 20 20 6e 6f 74 69 63 65 2c 20 74 68 69 73 20 notice, this
0200: 6c 69 73 74 20 6f 66 20 63 6f 6e 64 69 74 69 6f list of conditio
0210: 6e 73 20 61 6e 64 20 74 68 65 20 66 6f 6c 6c 6f ns and the follo
0220: 77 69 6e 67 20 64 69 73 63 6c 61 69 6d 65 72 20 wing disclaimer
0230: 69 6e 20 74 68 65 0a 3b 3b 3b 20 20 20 20 64 6f in the.;;; do
0240: 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 6e 64 2f cumentation and/
0250: 6f 72 20 6f 74 68 65 72 20 6d 61 74 65 72 69 61 or other materia
0260: 6c 73 20 70 72 6f 76 69 64 65 64 20 77 69 74 68 ls provided with
0270: 20 74 68 65 20 64 69 73 74 72 69 62 75 74 69 6f the distributio
0280: 6e 2e 0a 3b 3b 3b 20 33 2e 20 54 68 65 20 6e 61 n..;;; 3. The na
0290: 6d 65 20 6f 66 20 74 68 65 20 61 75 74 68 6f 72 me of the author
02a0: 73 20 6d 61 79 20 6e 6f 74 20 62 65 20 75 73 65 s may not be use
02b0: 64 20 74 6f 20 65 6e 64 6f 72 73 65 20 6f 72 20 d to endorse or
02c0: 70 72 6f 6d 6f 74 65 20 70 72 6f 64 75 63 74 73 promote products
02d0: 0a 3b 3b 3b 20 20 20 20 64 65 72 69 76 65 64 20 .;;; derived
02e0: 66 72 6f 6d 20 74 68 69 73 20 73 6f 66 74 77 61 from this softwa
02f0: 72 65 20 77 69 74 68 6f 75 74 20 73 70 65 63 69 re without speci
0300: 66 69 63 20 70 72 69 6f 72 20 77 72 69 74 74 65 fic prior writte
0310: 6e 20 70 65 72 6d 69 73 73 69 6f 6e 2e 0a 3b 3b n permission..;;
0320: 3b 0a 3b 3b 3b 20 54 48 49 53 20 53 4f 46 54 57 ;.;;; THIS SOFTW
0330: 41 52 45 20 49 53 20 50 52 4f 56 49 44 45 44 20 ARE IS PROVIDED
0340: 42 59 20 54 48 45 20 41 55 54 48 4f 52 53 20 60 BY THE AUTHORS `
0350: 60 41 53 20 49 53 27 27 20 41 4e 44 20 41 4e 59 `AS IS'' AND ANY
0360: 20 45 58 50 52 45 53 53 20 4f 52 0a 3b 3b 3b 20 EXPRESS OR.;;;
0370: 49 4d 50 4c 49 45 44 20 57 41 52 52 41 4e 54 49 IMPLIED WARRANTI
0380: 45 53 2c 20 49 4e 43 4c 55 44 49 4e 47 2c 20 42 ES, INCLUDING, B
0390: 55 54 20 4e 4f 54 20 4c 49 4d 49 54 45 44 20 54 UT NOT LIMITED T
03a0: 4f 2c 20 54 48 45 20 49 4d 50 4c 49 45 44 20 57 O, THE IMPLIED W
03b0: 41 52 52 41 4e 54 49 45 53 0a 3b 3b 3b 20 4f 46 ARRANTIES.;;; OF
03c0: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
03d0: 20 41 4e 44 20 46 49 54 4e 45 53 53 20 46 4f 52 AND FITNESS FOR
03e0: 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 A PARTICULAR PU
03f0: 52 50 4f 53 45 20 41 52 45 20 44 49 53 43 4c 41 RPOSE ARE DISCLA
0400: 49 4d 45 44 2e 0a 3b 3b 3b 20 49 4e 20 4e 4f 20 IMED..;;; IN NO
0410: 45 56 45 4e 54 20 53 48 41 4c 4c 20 54 48 45 20 EVENT SHALL THE
0420: 41 55 54 48 4f 52 53 20 42 45 20 4c 49 41 42 4c AUTHORS BE LIABL
0430: 45 20 46 4f 52 20 41 4e 59 20 44 49 52 45 43 54 E FOR ANY DIRECT
0440: 2c 20 49 4e 44 49 52 45 43 54 2c 0a 3b 3b 3b 20 , INDIRECT,.;;;
0450: 49 4e 43 49 44 45 4e 54 41 4c 2c 20 53 50 45 43 INCIDENTAL, SPEC
0460: 49 41 4c 2c 20 45 58 45 4d 50 4c 41 52 59 2c 20 IAL, EXEMPLARY,
0470: 4f 52 20 43 4f 4e 53 45 51 55 45 4e 54 49 41 4c OR CONSEQUENTIAL
0480: 20 44 41 4d 41 47 45 53 20 28 49 4e 43 4c 55 44 DAMAGES (INCLUD
0490: 49 4e 47 2c 20 42 55 54 0a 3b 3b 3b 20 4e 4f 54 ING, BUT.;;; NOT
04a0: 20 4c 49 4d 49 54 45 44 20 54 4f 2c 20 50 52 4f LIMITED TO, PRO
04b0: 43 55 52 45 4d 45 4e 54 20 4f 46 20 53 55 42 53 CUREMENT OF SUBS
04c0: 54 49 54 55 54 45 20 47 4f 4f 44 53 20 4f 52 20 TITUTE GOODS OR
04d0: 53 45 52 56 49 43 45 53 3b 20 4c 4f 53 53 20 4f SERVICES; LOSS O
04e0: 46 20 55 53 45 2c 0a 3b 3b 3b 20 44 41 54 41 2c F USE,.;;; DATA,
04f0: 20 4f 52 20 50 52 4f 46 49 54 53 3b 20 4f 52 20 OR PROFITS; OR
0500: 42 55 53 49 4e 45 53 53 20 49 4e 54 45 52 52 55 BUSINESS INTERRU
0510: 50 54 49 4f 4e 29 20 48 4f 57 45 56 45 52 20 43 PTION) HOWEVER C
0520: 41 55 53 45 44 20 41 4e 44 20 4f 4e 20 41 4e 59 AUSED AND ON ANY
0530: 0a 3b 3b 3b 20 54 48 45 4f 52 59 20 4f 46 20 4c .;;; THEORY OF L
0540: 49 41 42 49 4c 49 54 59 2c 20 57 48 45 54 48 45 IABILITY, WHETHE
0550: 52 20 49 4e 20 43 4f 4e 54 52 41 43 54 2c 20 53 R IN CONTRACT, S
0560: 54 52 49 43 54 20 4c 49 41 42 49 4c 49 54 59 2c TRICT LIABILITY,
0570: 20 4f 52 20 54 4f 52 54 0a 3b 3b 3b 20 28 49 4e OR TORT.;;; (IN
0580: 43 4c 55 44 49 4e 47 20 4e 45 47 4c 49 47 45 4e CLUDING NEGLIGEN
0590: 43 45 20 4f 52 20 4f 54 48 45 52 57 49 53 45 29 CE OR OTHERWISE)
05a0: 20 41 52 49 53 49 4e 47 20 49 4e 20 41 4e 59 20 ARISING IN ANY
05b0: 57 41 59 20 4f 55 54 20 4f 46 20 54 48 45 20 55 WAY OUT OF THE U
05c0: 53 45 20 4f 46 0a 3b 3b 3b 20 54 48 49 53 20 53 SE OF.;;; THIS S
05d0: 4f 46 54 57 41 52 45 2c 20 45 56 45 4e 20 49 46 OFTWARE, EVEN IF
05e0: 20 41 44 56 49 53 45 44 20 4f 46 20 54 48 45 20 ADVISED OF THE
05f0: 50 4f 53 53 49 42 49 4c 49 54 59 20 4f 46 20 53 POSSIBILITY OF S
0600: 55 43 48 20 44 41 4d 41 47 45 2e 0a 0a 3b 3b 3b UCH DAMAGE...;;;
0610: 20 4e 4f 54 45 3a 20 54 68 69 73 20 69 6d 70 6c NOTE: This impl
0620: 65 6d 65 6e 74 61 74 69 6f 6e 20 75 73 65 73 20 ementation uses
0630: 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 53 52 the following SR
0640: 46 49 73 3a 0a 3b 3b 3b 20 20 20 22 53 52 46 49 FIs:.;;; "SRFI
0650: 20 39 3a 20 44 65 66 69 6e 69 6e 67 20 52 65 63 9: Defining Rec
0660: 6f 72 64 20 54 79 70 65 73 22 0a 3b 3b 3b 20 20 ord Types".;;;
0670: 20 22 53 52 46 49 20 31 31 3a 20 53 79 6e 74 61 "SRFI 11: Synta
0680: 78 20 66 6f 72 20 72 65 63 65 69 76 69 6e 67 20 x for receiving
0690: 6d 75 6c 74 69 70 6c 65 20 76 61 6c 75 65 73 22 multiple values"
06a0: 0a 3b 3b 3b 0a 3b 3b 3b 20 4e 4f 54 45 3a 20 54 .;;;.;;; NOTE: T
06b0: 68 65 20 73 63 73 68 2d 75 74 69 6c 73 20 61 6e he scsh-utils an
06c0: 64 20 43 68 69 63 6b 65 6e 20 69 6d 70 6c 65 6d d Chicken implem
06d0: 65 6e 74 61 74 69 6f 6e 73 20 75 73 65 20 72 65 entations use re
06e0: 67 75 6c 61 72 0a 3b 3b 3b 20 65 78 70 72 65 73 gular.;;; expres
06f0: 73 69 6f 6e 73 2e 20 54 68 65 73 65 20 6d 69 67 sions. These mig
0700: 68 74 20 62 65 20 65 61 73 69 65 72 20 74 6f 20 ht be easier to
0710: 72 65 61 64 20 61 6e 64 20 75 6e 64 65 72 73 74 read and underst
0720: 61 6e 64 2e 0a 0a 23 7c 0a 28 64 65 66 69 6e 65 and...#|.(define
0730: 20 6f 70 74 69 6f 6e 20 23 66 29 0a 28 64 65 66 option #f).(def
0740: 69 6e 65 20 6f 70 74 69 6f 6e 2d 6e 61 6d 65 73 ine option-names
0750: 20 23 66 29 0a 28 64 65 66 69 6e 65 20 6f 70 74 #f).(define opt
0760: 69 6f 6e 2d 72 65 71 75 69 72 65 64 2d 61 72 67 ion-required-arg
0770: 3f 20 23 66 29 0a 28 64 65 66 69 6e 65 20 6f 70 ? #f).(define op
0780: 74 69 6f 6e 2d 6f 70 74 69 6f 6e 61 6c 2d 61 72 tion-optional-ar
0790: 67 3f 20 23 66 29 0a 28 64 65 66 69 6e 65 20 6f g? #f).(define o
07a0: 70 74 69 6f 6e 2d 70 72 6f 63 65 73 73 6f 72 20 ption-processor
07b0: 23 66 29 0a 28 64 65 66 69 6e 65 20 6f 70 74 69 #f).(define opti
07c0: 6f 6e 3f 20 23 66 29 0a 0a 28 6c 65 74 20 28 29 on? #f)..(let ()
07d0: 0a 20 20 28 64 65 66 69 6e 65 2d 72 65 63 6f 72 . (define-recor
07e0: 64 2d 74 79 70 65 20 6f 70 74 69 6f 6e 2d 74 79 d-type option-ty
07f0: 70 65 0a 20 20 20 20 28 24 6f 70 74 69 6f 6e 20 pe. ($option
0800: 6e 61 6d 65 73 20 72 65 71 75 69 72 65 64 2d 61 names required-a
0810: 72 67 3f 20 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 rg? optional-arg
0820: 3f 20 70 72 6f 63 65 73 73 6f 72 29 0a 20 20 20 ? processor).
0830: 20 24 6f 70 74 69 6f 6e 3f 0a 20 20 20 20 28 6e $option?. (n
0840: 61 6d 65 73 20 24 6f 70 74 69 6f 6e 2d 6e 61 6d ames $option-nam
0850: 65 73 29 0a 20 20 20 20 28 72 65 71 75 69 72 65 es). (require
0860: 64 2d 61 72 67 3f 20 24 6f 70 74 69 6f 6e 2d 72 d-arg? $option-r
0870: 65 71 75 69 72 65 64 2d 61 72 67 3f 29 0a 20 20 equired-arg?).
0880: 20 20 28 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 3f (optional-arg?
0890: 20 24 6f 70 74 69 6f 6e 2d 6f 70 74 69 6f 6e 61 $option-optiona
08a0: 6c 2d 61 72 67 3f 29 0a 20 20 20 20 28 70 72 6f l-arg?). (pro
08b0: 63 65 73 73 6f 72 20 24 6f 70 74 69 6f 6e 2d 70 cessor $option-p
08c0: 72 6f 63 65 73 73 6f 72 29 29 0a 20 20 28 73 65 rocessor)). (se
08d0: 74 21 20 6f 70 74 69 6f 6e 20 24 6f 70 74 69 6f t! option $optio
08e0: 6e 29 0a 20 20 28 73 65 74 21 20 6f 70 74 69 6f n). (set! optio
08f0: 6e 2d 6e 61 6d 65 73 20 24 6f 70 74 69 6f 6e 2d n-names $option-
0900: 6e 61 6d 65 73 29 0a 20 20 28 73 65 74 21 20 6f names). (set! o
0910: 70 74 69 6f 6e 2d 72 65 71 75 69 72 65 64 2d 61 ption-required-a
0920: 72 67 3f 20 24 6f 70 74 69 6f 6e 2d 72 65 71 75 rg? $option-requ
0930: 69 72 65 64 2d 61 72 67 3f 29 0a 20 20 28 73 65 ired-arg?). (se
0940: 74 21 20 6f 70 74 69 6f 6e 2d 6f 70 74 69 6f 6e t! option-option
0950: 61 6c 2d 61 72 67 3f 20 24 6f 70 74 69 6f 6e 2d al-arg? $option-
0960: 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 3f 29 0a 20 optional-arg?).
0970: 20 28 73 65 74 21 20 6f 70 74 69 6f 6e 2d 70 72 (set! option-pr
0980: 6f 63 65 73 73 6f 72 20 24 6f 70 74 69 6f 6e 2d ocessor $option-
0990: 70 72 6f 63 65 73 73 6f 72 29 0a 20 20 28 73 65 processor). (se
09a0: 74 21 20 6f 70 74 69 6f 6e 3f 20 24 6f 70 74 69 t! option? $opti
09b0: 6f 6e 3f 29 29 0a 7c 23 0a 0a 28 64 65 66 69 6e on?)).|#..(defin
09c0: 65 20 61 72 67 73 2d 66 6f 6c 64 0a 20 20 28 6c e args-fold. (l
09d0: 61 6d 62 64 61 20 28 61 72 67 73 0a 20 20 20 20 ambda (args.
09e0: 20 20 20 20 20 20 20 6f 70 74 69 6f 6e 73 0a 20 options.
09f0: 20 20 20 20 20 20 20 20 20 20 75 6e 72 65 63 6f unreco
0a00: 67 6e 69 7a 65 64 2d 6f 70 74 69 6f 6e 2d 70 72 gnized-option-pr
0a10: 6f 63 0a 20 20 20 20 20 20 20 20 20 20 20 6f 70 oc. op
0a20: 65 72 61 6e 64 2d 70 72 6f 63 0a 20 20 20 20 20 erand-proc.
0a30: 20 20 20 20 20 20 2e 20 73 65 65 64 73 29 0a 20 . seeds).
0a40: 20 20 20 28 6c 65 74 72 65 63 0a 20 20 20 20 20 (letrec.
0a50: 20 20 20 28 28 66 69 6e 64 0a 20 20 20 20 20 20 ((find.
0a60: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6c 20 3f (lambda (l ?
0a70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 63 ). (c
0a80: 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 6c 29 20 23 ond ((null? l) #
0a90: 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 f).
0aa0: 20 20 20 20 20 28 28 3f 20 28 63 61 72 20 6c 29 ((? (car l)
0ab0: 29 20 28 63 61 72 20 6c 29 29 0a 20 20 20 20 20 ) (car l)).
0ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
0ad0: 73 65 20 28 66 69 6e 64 20 28 63 64 72 20 6c 29 se (find (cdr l)
0ae0: 20 3f 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ?))))).
0af0: 20 28 66 69 6e 64 2d 6f 70 74 69 6f 6e 0a 20 20 (find-option.
0b00: 20 20 20 20 20 20 20 20 3b 3b 20 49 53 53 55 45 ;; ISSUE
0b10: 3a 20 54 68 69 73 20 69 73 20 61 20 62 72 75 74 : This is a brut
0b20: 65 20 66 6f 72 63 65 20 73 65 61 72 63 68 2e 20 e force search.
0b30: 43 6f 75 6c 64 20 75 73 65 20 61 20 74 61 62 6c Could use a tabl
0b40: 65 2e 0a 20 20 20 20 20 20 20 20 20 20 28 6c 61 e.. (la
0b50: 6d 62 64 61 20 28 6e 61 6d 65 29 0a 20 20 20 20 mbda (name).
0b60: 20 20 20 20 20 20 20 20 28 66 69 6e 64 0a 20 20 (find.
0b70: 20 20 20 20 20 20 20 20 20 20 20 6f 70 74 69 6f optio
0b80: 6e 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ns.
0b90: 28 6c 61 6d 62 64 61 20 28 6f 70 74 69 6f 6e 29 (lambda (option)
0ba0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0bb0: 28 66 69 6e 64 0a 20 20 20 20 20 20 20 20 20 20 (find.
0bc0: 20 20 20 20 20 20 28 6f 70 74 69 6f 6e 2d 6e 61 (option-na
0bd0: 6d 65 73 20 6f 70 74 69 6f 6e 29 0a 20 20 20 20 mes option).
0be0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
0bf0: 62 64 61 20 28 74 65 73 74 2d 6e 61 6d 65 29 0a bda (test-name).
0c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c10: 20 20 28 65 71 75 61 6c 3f 20 6e 61 6d 65 20 74 (equal? name t
0c20: 65 73 74 2d 6e 61 6d 65 29 29 29 29 29 29 29 0a est-name))))))).
0c30: 20 20 20 20 20 20 20 20 20 28 73 63 61 6e 2d 73 (scan-s
0c40: 68 6f 72 74 2d 6f 70 74 69 6f 6e 73 0a 20 20 20 hort-options.
0c50: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
0c60: 69 6e 64 65 78 20 73 68 6f 72 74 73 20 61 72 67 index shorts arg
0c70: 73 20 73 65 65 64 73 29 0a 20 20 20 20 20 20 20 s seeds).
0c80: 20 20 20 20 20 28 69 66 20 28 3d 20 69 6e 64 65 (if (= inde
0c90: 78 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 x (string-length
0ca0: 20 73 68 6f 72 74 73 29 29 0a 20 20 20 20 20 20 shorts)).
0cb0: 20 20 20 20 20 20 20 20 20 20 28 73 63 61 6e 2d (scan-
0cc0: 61 72 67 73 20 61 72 67 73 20 73 65 65 64 73 29 args args seeds)
0cd0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0ce0: 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 28 73 (let* ((name (s
0cf0: 74 72 69 6e 67 2d 72 65 66 20 73 68 6f 72 74 73 tring-ref shorts
0d00: 20 69 6e 64 65 78 29 29 0a 20 20 20 20 20 20 20 index)).
0d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d20: 28 6f 70 74 69 6f 6e 20 28 6f 72 20 28 66 69 6e (option (or (fin
0d30: 64 2d 6f 70 74 69 6f 6e 20 6e 61 6d 65 29 0a 20 d-option name).
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d60: 20 20 28 6f 70 74 69 6f 6e 20 28 6c 69 73 74 20 (option (list
0d70: 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 name).
0d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0da0: 20 23 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 #f.
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
0dd0: 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 f.
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 75 6e 72 unr
0e00: 65 63 6f 67 6e 69 7a 65 64 2d 6f 70 74 69 6f 6e ecognized-option
0e10: 2d 70 72 6f 63 29 29 29 29 0a 20 20 20 20 20 20 -proc)))).
0e20: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
0e30: 64 20 28 28 61 6e 64 20 28 3c 20 28 2b 20 69 6e d ((and (< (+ in
0e40: 64 65 78 20 31 29 20 28 73 74 72 69 6e 67 2d 6c dex 1) (string-l
0e50: 65 6e 67 74 68 20 73 68 6f 72 74 73 29 29 0a 20 ength shorts)).
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 72 (or
0e80: 20 28 6f 70 74 69 6f 6e 2d 72 65 71 75 69 72 65 (option-require
0e90: 64 2d 61 72 67 3f 20 6f 70 74 69 6f 6e 29 0a 20 d-arg? option).
0ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ec0: 20 28 6f 70 74 69 6f 6e 2d 6f 70 74 69 6f 6e 61 (option-optiona
0ed0: 6c 2d 61 72 67 3f 20 6f 70 74 69 6f 6e 29 29 29 l-arg? option)))
0ee0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0ef0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2d 76 (let-v
0f00: 61 6c 75 65 73 0a 20 20 20 20 20 20 20 20 20 20 alues.
0f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f20: 20 20 20 28 28 73 65 65 64 73 20 28 61 70 70 6c ((seeds (appl
0f30: 79 20 28 6f 70 74 69 6f 6e 2d 70 72 6f 63 65 73 y (option-proces
0f40: 73 6f 72 20 6f 70 74 69 6f 6e 29 0a 20 20 20 20 sor option).
0f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f70: 20 20 20 20 20 20 20 20 6f 70 74 69 6f 6e 0a 20 option.
0f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fa0: 20 20 20 20 20 20 20 20 20 20 20 6e 61 6d 65 0a name.
0fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fd0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 62 (sub
0fe0: 73 74 72 69 6e 67 0a 20 20 20 20 20 20 20 20 20 string.
0ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1010: 20 20 20 20 73 68 6f 72 74 73 0a 20 20 20 20 20 shorts.
1020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1040: 20 20 20 20 20 20 20 20 28 2b 20 69 6e 64 65 78 (+ index
1050: 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 1).
1060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1080: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
1090: 73 68 6f 72 74 73 29 29 0a 20 20 20 20 20 20 20 shorts)).
10a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10c0: 20 20 20 20 20 73 65 65 64 73 29 29 29 0a 20 20 seeds))).
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 28 73 63 61 6e 2d 61 (scan-a
10f0: 72 67 73 20 61 72 67 73 20 73 65 65 64 73 29 29 rgs args seeds))
1100: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1110: 20 20 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 ((and
1120: 28 6f 70 74 69 6f 6e 2d 72 65 71 75 69 72 65 64 (option-required
1130: 2d 61 72 67 3f 20 6f 70 74 69 6f 6e 29 0a 20 20 -arg? option).
1140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1150: 20 20 20 20 20 20 20 20 20 20 20 20 28 70 61 69 (pai
1160: 72 3f 20 61 72 67 73 29 29 0a 20 20 20 20 20 20 r? args)).
1170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1180: 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 20 (let-values.
1190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 65 ((se
11b0: 65 64 73 20 28 61 70 70 6c 79 20 28 6f 70 74 69 eds (apply (opti
11c0: 6f 6e 2d 70 72 6f 63 65 73 73 6f 72 20 6f 70 74 on-processor opt
11d0: 69 6f 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 ion).
11e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1200: 20 6f 70 74 69 6f 6e 0a 20 20 20 20 20 20 20 20 option.
1210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1230: 20 20 20 20 6e 61 6d 65 0a 20 20 20 20 20 20 20 name.
1240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1260: 20 20 20 20 20 28 63 61 72 20 61 72 67 73 29 0a (car args).
1270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1290: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 65 64 seed
12a0: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
12b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12c0: 28 73 63 61 6e 2d 61 72 67 73 20 28 63 64 72 20 (scan-args (cdr
12d0: 61 72 67 73 29 20 73 65 65 64 73 29 29 29 0a 20 args) seeds))).
12e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12f0: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else.
1300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1310: 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 (let-value
1320: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
1330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1340: 28 73 65 65 64 73 20 28 61 70 70 6c 79 20 28 6f (seeds (apply (o
1350: 70 74 69 6f 6e 2d 70 72 6f 63 65 73 73 6f 72 20 ption-processor
1360: 6f 70 74 69 6f 6e 29 0a 20 20 20 20 20 20 20 20 option).
1370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1390: 20 20 20 20 6f 70 74 69 6f 6e 0a 20 20 20 20 20 option.
13a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13c0: 20 20 20 20 20 20 20 6e 61 6d 65 0a 20 20 20 20 name.
13d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13f0: 20 20 20 20 20 20 20 20 23 66 0a 20 20 20 20 20 #f.
1400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1420: 20 20 20 20 20 20 20 73 65 65 64 73 29 29 29 0a seeds))).
1430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1440: 20 20 20 20 20 20 20 20 20 20 20 28 73 63 61 6e (scan
1450: 2d 73 68 6f 72 74 2d 6f 70 74 69 6f 6e 73 0a 20 -short-options.
1460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1470: 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 69 6e (+ in
1480: 64 65 78 20 31 29 0a 20 20 20 20 20 20 20 20 20 dex 1).
1490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14a0: 20 20 20 73 68 6f 72 74 73 0a 20 20 20 20 20 20 shorts.
14b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14c0: 20 20 20 20 20 20 61 72 67 73 0a 20 20 20 20 20 args.
14d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14e0: 20 20 20 20 20 20 20 73 65 65 64 73 29 29 29 29 seeds))))
14f0: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 73 )))). (s
1500: 63 61 6e 2d 6f 70 65 72 61 6e 64 73 0a 20 20 20 can-operands.
1510: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
1520: 6f 70 65 72 61 6e 64 73 20 73 65 65 64 73 29 0a operands seeds).
1530: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
1540: 28 6e 75 6c 6c 3f 20 6f 70 65 72 61 6e 64 73 29 (null? operands)
1550: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1560: 20 28 61 70 70 6c 79 20 76 61 6c 75 65 73 20 73 (apply values s
1570: 65 65 64 73 29 0a 20 20 20 20 20 20 20 20 20 20 eeds).
1580: 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 (let-value
1590: 73 20 28 28 73 65 65 64 73 20 28 61 70 70 6c 79 s ((seeds (apply
15a0: 20 6f 70 65 72 61 6e 64 2d 70 72 6f 63 0a 20 20 operand-proc.
15b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15d0: 20 20 20 20 20 20 20 20 20 28 63 61 72 20 6f 70 (car op
15e0: 65 72 61 6e 64 73 29 0a 20 20 20 20 20 20 20 20 erands).
15f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1610: 20 20 20 73 65 65 64 73 29 29 29 0a 20 20 20 20 seeds))).
1620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
1630: 63 61 6e 2d 6f 70 65 72 61 6e 64 73 20 28 63 64 can-operands (cd
1640: 72 20 6f 70 65 72 61 6e 64 73 29 20 73 65 65 64 r operands) seed
1650: 73 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 s))))).
1660: 28 73 63 61 6e 2d 61 72 67 73 0a 20 20 20 20 20 (scan-args.
1670: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 72 (lambda (ar
1680: 67 73 20 73 65 65 64 73 29 0a 20 20 20 20 20 20 gs seeds).
1690: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null?
16a0: 20 61 72 67 73 29 0a 20 20 20 20 20 20 20 20 20 args).
16b0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 76 61 (apply va
16c0: 6c 75 65 73 20 73 65 65 64 73 29 0a 20 20 20 20 lues seeds).
16d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
16e0: 20 28 28 61 72 67 20 28 63 61 72 20 61 72 67 73 ((arg (car args
16f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1700: 20 20 20 20 20 20 20 20 20 28 61 72 67 73 20 28 (args (
1710: 63 64 72 20 61 72 67 73 29 29 29 0a 20 20 20 20 cdr args))).
1720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
1730: 20 4e 4f 54 45 3a 20 54 68 69 73 20 73 74 72 69 NOTE: This stri
1740: 6e 67 20 6d 61 74 63 68 69 6e 67 20 63 6f 64 65 ng matching code
1750: 20 77 6f 75 6c 64 20 62 65 20 73 69 6d 70 6c 65 would be simple
1760: 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
1770: 20 20 20 20 3b 3b 20 75 73 69 6e 67 20 61 20 72 ;; using a r
1780: 65 67 75 6c 61 72 20 65 78 70 72 65 73 73 69 6f egular expressio
1790: 6e 20 6d 61 74 63 68 65 72 2e 0a 20 20 20 20 20 n matcher..
17a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
17b0: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
17c0: 20 20 20 20 20 20 28 3b 3b 20 28 72 78 20 62 6f (;; (rx bo
17d0: 73 20 22 2d 2d 22 20 65 6f 73 29 0a 20 20 20 20 s "--" eos).
17e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17f0: 28 73 74 72 69 6e 67 3d 3f 20 22 2d 2d 22 20 61 (string=? "--" a
1800: 72 67 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rg).
1810: 20 20 20 20 20 20 20 20 3b 3b 20 45 6e 64 20 6f ;; End o
1820: 70 74 69 6f 6e 20 73 63 61 6e 6e 69 6e 67 3a 0a ption scanning:.
1830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1840: 20 20 20 20 28 73 63 61 6e 2d 6f 70 65 72 61 6e (scan-operan
1850: 64 73 20 61 72 67 73 20 73 65 65 64 73 29 29 0a ds args seeds)).
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1870: 20 20 20 28 3b 3b 28 72 78 20 62 6f 73 0a 20 20 (;;(rx bos.
1880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1890: 20 20 3b 3b 20 20 20 20 22 2d 2d 22 0a 20 20 20 ;; "--".
18a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18b0: 20 3b 3b 20 20 20 20 28 73 75 62 6d 61 74 63 68 ;; (submatch
18c0: 20 28 2b 20 28 7e 20 22 3d 22 29 29 29 0a 20 20 (+ (~ "="))).
18d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18e0: 20 20 3b 3b 20 20 20 20 22 3d 22 0a 20 20 20 20 ;; "=".
18f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1900: 3b 3b 20 20 20 20 28 73 75 62 6d 61 74 63 68 20 ;; (submatch
1910: 28 2a 20 61 6e 79 29 29 29 0a 20 20 20 20 20 20 (* any))).
1920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
1930: 6e 64 20 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 nd (> (string-le
1940: 6e 67 74 68 20 61 72 67 29 20 34 29 0a 20 20 20 ngth arg) 4).
1950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1960: 20 20 20 20 20 20 28 63 68 61 72 3d 3f 20 23 5c (char=? #\
1970: 2d 20 28 73 74 72 69 6e 67 2d 72 65 66 20 61 72 - (string-ref ar
1980: 67 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 g 0)).
1990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
19a0: 63 68 61 72 3d 3f 20 23 5c 2d 20 28 73 74 72 69 char=? #\- (stri
19b0: 6e 67 2d 72 65 66 20 61 72 67 20 31 29 29 0a 20 ng-ref arg 1)).
19c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d0: 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 63 68 (not (ch
19e0: 61 72 3d 3f 20 23 5c 3d 20 28 73 74 72 69 6e 67 ar=? #\= (string
19f0: 2d 72 65 66 20 61 72 67 20 32 29 29 29 0a 20 20 -ref arg 2))).
1a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a10: 20 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 (let loop
1a20: 20 28 28 69 6e 64 65 78 20 33 29 29 0a 20 20 20 ((index 3)).
1a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a40: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 (cond ((
1a50: 3d 20 69 6e 64 65 78 20 28 73 74 72 69 6e 67 2d = index (string-
1a60: 6c 65 6e 67 74 68 20 61 72 67 29 29 0a 20 20 20 length arg)).
1a70: 20 20 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 20 20 20 20 23 #
1a90: 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 f).
1aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ab0: 20 20 20 20 28 28 63 68 61 72 3d 3f 20 23 5c 3d ((char=? #\=
1ac0: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 61 72 67 (string-ref arg
1ad0: 20 69 6e 64 65 78 29 29 0a 20 20 20 20 20 20 20 index)).
1ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1af0: 20 20 20 20 20 20 20 20 20 20 20 69 6e 64 65 78 index
1b00: 29 0a 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 20 20 20 20 20 20
1b20: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else.
1b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b40: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
1b50: 20 28 2b 20 31 20 69 6e 64 65 78 29 29 29 29 29 (+ 1 index)))))
1b60: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1b70: 20 20 20 20 20 20 3b 3b 20 46 6f 75 6e 64 20 6c ;; Found l
1b80: 6f 6e 67 20 6f 70 74 69 6f 6e 20 77 69 74 68 20 ong option with
1b90: 61 72 67 3a 0a 20 20 20 20 20 20 20 20 20 20 20 arg:.
1ba0: 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c 61 6d => (lam
1bb0: 62 64 61 20 28 3d 2d 69 6e 64 65 78 29 0a 20 20 bda (=-index).
1bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bd0: 20 20 20 20 20 20 20 28 6c 65 74 2a 2d 76 61 6c (let*-val
1be0: 75 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 ues.
1bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c00: 20 28 28 28 6e 61 6d 65 29 0a 20 20 20 20 20 20 (((name).
1c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c20: 20 20 20 20 20 20 20 20 20 28 73 75 62 73 74 72 (substr
1c30: 69 6e 67 20 61 72 67 20 32 20 3d 2d 69 6e 64 65 ing arg 2 =-inde
1c40: 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 x)).
1c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c60: 20 20 28 28 6f 70 74 69 6f 6e 2d 61 72 67 29 0a ((option-arg).
1c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1c90: 73 75 62 73 74 72 69 6e 67 20 61 72 67 0a 20 20 substring arg.
1ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cc0: 20 20 20 20 20 20 20 20 28 2b 20 3d 2d 69 6e 64 (+ =-ind
1cd0: 65 78 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 ex 1).
1ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d00: 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 61 (string-length a
1d10: 72 67 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 rg))).
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d30: 20 20 20 20 28 28 6f 70 74 69 6f 6e 29 0a 20 20 ((option).
1d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 72 (or
1d60: 20 28 66 69 6e 64 2d 6f 70 74 69 6f 6e 20 6e 61 (find-option na
1d70: 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 me).
1d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d90: 20 20 20 20 20 20 20 28 6f 70 74 69 6f 6e 20 28 (option (
1da0: 6c 69 73 74 20 6e 61 6d 65 29 0a 20 20 20 20 20 list name).
1db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dd0: 20 20 20 20 20 20 23 74 0a 20 20 20 20 20 20 20 #t.
1de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e00: 20 20 20 20 23 66 0a 20 20 20 20 20 20 20 20 20 #f.
1e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e30: 20 20 75 6e 72 65 63 6f 67 6e 69 7a 65 64 2d 6f unrecognized-o
1e40: 70 74 69 6f 6e 2d 70 72 6f 63 29 29 29 0a 20 20 ption-proc))).
1e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 65 (see
1e70: 64 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ds.
1e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e90: 20 20 28 61 70 70 6c 79 20 28 6f 70 74 69 6f 6e (apply (option
1ea0: 2d 70 72 6f 63 65 73 73 6f 72 20 6f 70 74 69 6f -processor optio
1eb0: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
1ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ed0: 20 20 20 20 20 20 20 20 20 6f 70 74 69 6f 6e 0a option.
1ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f00: 20 20 20 20 20 20 6e 61 6d 65 0a 20 20 20 20 20 name.
1f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f30: 20 6f 70 74 69 6f 6e 2d 61 72 67 0a 20 20 20 20 option-arg.
1f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f60: 20 20 73 65 65 64 73 29 29 29 0a 20 20 20 20 20 seeds))).
1f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f80: 20 20 20 20 20 20 28 73 63 61 6e 2d 61 72 67 73 (scan-args
1f90: 20 61 72 67 73 20 73 65 65 64 73 29 29 29 29 0a args seeds)))).
1fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fb0: 20 20 20 28 3b 3b 28 72 78 20 62 6f 73 20 22 2d (;;(rx bos "-
1fc0: 2d 22 20 28 73 75 62 6d 61 74 63 68 20 28 2b 20 -" (submatch (+
1fd0: 61 6e 79 29 29 29 0a 20 20 20 20 20 20 20 20 20 any))).
1fe0: 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 (and
1ff0: 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 (> (string-lengt
2000: 68 20 61 72 67 29 20 33 29 0a 20 20 20 20 20 20 h arg) 3).
2010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2020: 20 20 20 28 63 68 61 72 3d 3f 20 23 5c 2d 20 28 (char=? #\- (
2030: 73 74 72 69 6e 67 2d 72 65 66 20 61 72 67 20 30 string-ref arg 0
2040: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2050: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 68 61 (cha
2060: 72 3d 3f 20 23 5c 2d 20 28 73 74 72 69 6e 67 2d r=? #\- (string-
2070: 72 65 66 20 61 72 67 20 31 29 29 29 0a 20 20 20 ref arg 1))).
2080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2090: 20 3b 3b 20 46 6f 75 6e 64 20 6c 6f 6e 67 20 6f ;; Found long o
20a0: 70 74 69 6f 6e 3a 0a 20 20 20 20 20 20 20 20 20 ption:.
20b0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
20c0: 20 28 28 6e 61 6d 65 20 28 73 75 62 73 74 72 69 ((name (substri
20d0: 6e 67 20 61 72 67 20 32 20 28 73 74 72 69 6e 67 ng arg 2 (string
20e0: 2d 6c 65 6e 67 74 68 20 61 72 67 29 29 29 0a 20 -length arg))).
20f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2100: 20 20 20 20 20 20 20 20 20 20 28 6f 70 74 69 6f (optio
2110: 6e 20 28 6f 72 20 28 66 69 6e 64 2d 6f 70 74 69 n (or (find-opti
2120: 6f 6e 20 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 on name).
2130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2150: 28 6f 70 74 69 6f 6e 0a 20 20 20 20 20 20 20 20 (option.
2160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2180: 28 6c 69 73 74 20 6e 61 6d 65 29 0a 20 20 20 20 (list name).
2190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21b0: 20 20 20 20 23 66 0a 20 20 20 20 20 20 20 20 20 #f.
21c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
21e0: 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 f.
21f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2200: 20 20 20 20 20 20 20 20 20 20 75 6e 72 65 63 6f unreco
2210: 67 6e 69 7a 65 64 2d 6f 70 74 69 6f 6e 2d 70 72 gnized-option-pr
2220: 6f 63 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 oc)))).
2230: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
2240: 20 28 61 6e 64 20 28 6f 70 74 69 6f 6e 2d 72 65 (and (option-re
2250: 71 75 69 72 65 64 2d 61 72 67 3f 20 6f 70 74 69 quired-arg? opti
2260: 6f 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 on).
2270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2280: 20 20 20 28 70 61 69 72 3f 20 61 72 67 73 29 29 (pair? args))
2290: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
22a0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2d (let-
22b0: 76 61 6c 75 65 73 0a 20 20 20 20 20 20 20 20 20 values.
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22d0: 20 20 20 20 20 28 28 73 65 65 64 73 20 28 61 70 ((seeds (ap
22e0: 70 6c 79 20 28 6f 70 74 69 6f 6e 2d 70 72 6f 63 ply (option-proc
22f0: 65 73 73 6f 72 20 6f 70 74 69 6f 6e 29 0a 20 20 essor option).
2300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2320: 20 20 20 20 20 20 20 20 20 20 20 6f 70 74 69 6f optio
2330: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
2340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e n
2360: 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ame.
2370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2390: 20 28 63 61 72 20 61 72 67 73 29 0a 20 20 20 20 (car args).
23a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23c0: 20 20 20 20 20 20 20 20 20 73 65 65 64 73 29 29 seeds))
23d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
23e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
23f0: 63 61 6e 2d 61 72 67 73 20 28 63 64 72 20 61 72 can-args (cdr ar
2400: 67 73 29 20 73 65 65 64 73 29 29 0a 20 20 20 20 gs) seeds)).
2410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2420: 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 (let-value
2430: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
2440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2450: 28 28 73 65 65 64 73 20 28 61 70 70 6c 79 20 28 ((seeds (apply (
2460: 6f 70 74 69 6f 6e 2d 70 72 6f 63 65 73 73 6f 72 option-processor
2470: 20 6f 70 74 69 6f 6e 29 0a 20 20 20 20 20 20 20 option).
2480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24a0: 20 20 20 20 20 20 6f 70 74 69 6f 6e 0a 20 20 20 option.
24b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24d0: 20 20 20 20 20 20 20 20 20 20 6e 61 6d 65 0a 20 name.
24e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2500: 20 20 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 #f.
2510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2530: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 65 64 seed
2540: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
2550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2560: 20 28 73 63 61 6e 2d 61 72 67 73 20 61 72 67 73 (scan-args args
2570: 20 73 65 65 64 73 29 29 29 29 29 0a 20 20 20 20 seeds))))).
2580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2590: 3b 3b 20 28 72 78 20 62 6f 73 20 22 2d 22 20 28 ;; (rx bos "-" (
25a0: 73 75 62 6d 61 74 63 68 20 28 2b 20 61 6e 79 29 submatch (+ any)
25b0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
25c0: 20 20 20 20 20 20 20 28 61 6e 64 20 28 3e 20 28 (and (> (
25d0: 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 61 72 string-length ar
25e0: 67 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 g) 1).
25f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2600: 63 68 61 72 3d 3f 20 23 5c 2d 20 28 73 74 72 69 char=? #\- (stri
2610: 6e 67 2d 72 65 66 20 61 72 67 20 30 29 29 29 0a ng-ref arg 0))).
2620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2630: 20 20 20 20 3b 3b 20 46 6f 75 6e 64 20 73 68 6f ;; Found sho
2640: 72 74 20 6f 70 74 69 6f 6e 73 0a 20 20 20 20 20 rt options.
2650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2660: 6c 65 74 20 28 28 73 68 6f 72 74 73 20 28 73 75 let ((shorts (su
2670: 62 73 74 72 69 6e 67 20 61 72 67 20 31 20 28 73 bstring arg 1 (s
2680: 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 61 72 67 tring-length arg
2690: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
26a0: 20 20 20 20 20 20 20 20 20 20 20 28 73 63 61 6e (scan
26b0: 2d 73 68 6f 72 74 2d 6f 70 74 69 6f 6e 73 20 30 -short-options 0
26c0: 20 73 68 6f 72 74 73 20 61 72 67 73 20 73 65 65 shorts args see
26d0: 64 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ds))).
26e0: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
26f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2700: 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 (let-values (
2710: 28 73 65 65 64 73 20 28 61 70 70 6c 79 20 6f 70 (seeds (apply op
2720: 65 72 61 6e 64 2d 70 72 6f 63 20 61 72 67 20 73 erand-proc arg s
2730: 65 65 64 73 29 29 29 0a 20 20 20 20 20 20 20 20 eeds))).
2740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
2750: 63 61 6e 2d 61 72 67 73 20 61 72 67 73 20 73 65 can-args args se
2760: 65 64 73 29 29 29 29 29 29 29 29 29 0a 20 20 20 eds))))))))).
2770: 20 20 20 28 73 63 61 6e 2d 61 72 67 73 20 61 72 (scan-args ar
2780: 67 73 20 73 65 65 64 73 29 29 29 29 0a gs seeds)))).