Hex Artifact Content
Not logged in

Artifact 450c23aace4b2f39d5de7b11572609fa54cc7f53:


0000: 23 21 72 36 72 73 0a 28 69 6d 70 6f 72 74 0a 20  #!r6rs.(import. 
0010: 20 28 72 6e 72 73 29 0a 20 20 28 6f 6e 6c 79 20   (rnrs).  (only 
0020: 28 73 72 66 69 20 70 72 69 76 61 74 65 20 72 65  (srfi private re
0030: 67 69 73 74 72 79 29 20 61 76 61 69 6c 61 62 6c  gistry) availabl
0040: 65 2d 66 65 61 74 75 72 65 73 29 0a 20 20 28 6f  e-features).  (o
0050: 6e 6c 79 20 28 78 69 74 6f 6d 61 74 6c 20 6c 69  nly (xitomatl li
0060: 73 74 73 29 20 6d 61 70 2f 66 69 6c 74 65 72 29  sts) map/filter)
0070: 0a 20 20 28 6f 6e 6c 79 20 28 78 69 74 6f 6d 61  .  (only (xitoma
0080: 74 6c 20 6d 61 74 63 68 29 20 6d 61 74 63 68 2d  tl match) match-
0090: 6c 61 6d 62 64 61 29 0a 20 20 28 6f 6e 6c 79 20  lambda).  (only 
00a0: 28 78 69 74 6f 6d 61 74 6c 20 63 6f 6d 6d 6f 6e  (xitomatl common
00b0: 29 20 66 6f 72 6d 61 74 20 66 70 72 69 6e 74 66  ) format fprintf
00c0: 20 70 72 69 6e 74 66 29 0a 20 20 28 6f 6e 6c 79   printf).  (only
00d0: 20 28 78 69 74 6f 6d 61 74 6c 20 73 74 72 69 6e   (xitomatl strin
00e0: 67 73 29 20 73 74 72 69 6e 67 2d 69 6e 74 65 72  gs) string-inter
00f0: 73 70 65 72 73 65 29 0a 20 20 28 6f 6e 6c 79 20  sperse).  (only 
0100: 28 78 69 74 6f 6d 61 74 6c 20 70 72 65 64 69 63  (xitomatl predic
0110: 61 74 65 73 29 20 73 79 6d 62 6f 6c 3c 3f 29 0a  ates) symbol<?).
0120: 20 20 28 6f 6e 6c 79 20 28 78 69 74 6f 6d 61 74    (only (xitomat
0130: 6c 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 73 29 20  l environments) 
0140: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 65 6e 76 69  environment envi
0150: 72 6f 6e 6d 65 6e 74 2d 73 79 6d 62 6f 6c 73 29  ronment-symbols)
0160: 29 0a 0a 28 64 65 66 69 6e 65 20 73 72 66 69 2d  )..(define srfi-
0170: 6c 69 62 72 61 72 69 65 73 2f 6d 6e 65 6d 6f 6e  libraries/mnemon
0180: 69 63 73 0a 20 20 28 6d 61 70 2f 66 69 6c 74 65  ics.  (map/filte
0190: 72 20 28 6d 61 74 63 68 2d 6c 61 6d 62 64 61 0a  r (match-lambda.
01a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
01b0: 3b 3b 20 4e 4f 54 45 3a 20 55 73 65 73 20 6f 6e  ;; NOTE: Uses on
01c0: 6c 79 20 74 68 65 20 33 2d 65 6c 65 6d 65 6e 74  ly the 3-element
01d0: 20 6e 61 6d 65 73 2e 0a 20 20 20 20 20 20 20 20   names..        
01e0: 20 20 20 20 20 20 20 20 28 28 3a 61 6e 64 20 28          ((:and (
01f0: 27 73 72 66 69 20 28 3a 73 79 6d 62 6f 6c 20 22  'srfi (:symbol "
0200: 3a 28 5c 5c 64 2b 29 22 20 6e 75 6d 29 20 5f 29  :(\\d+)" num) _)
0210: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
0220: 20 20 20 20 20 20 20 20 6e 61 6d 65 29 0a 20 20          name).  
0230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
0240: 6c 69 73 74 20 28 73 74 72 69 6e 67 2d 3e 6e 75  list (string->nu
0250: 6d 62 65 72 20 28 73 79 6d 62 6f 6c 2d 3e 73 74  mber (symbol->st
0260: 72 69 6e 67 20 6e 75 6d 29 29 0a 20 20 20 20 20  ring num)).     
0270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0280: 20 20 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 20    name)).       
0290: 20 20 20 20 20 20 20 20 20 28 5f 20 23 46 29 29           (_ #F))
02a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61  .              a
02b0: 76 61 69 6c 61 62 6c 65 2d 66 65 61 74 75 72 65  vailable-feature
02c0: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 61 6c 69  s))..(define ali
02d0: 61 73 2d 74 65 6d 70 6c 61 74 65 0a 22 3b 3b 20  as-template.";; 
02e0: 41 75 74 6f 6d 61 74 69 63 61 6c 6c 79 20 67 65  Automatically ge
02f0: 6e 65 72 61 74 65 64 20 62 79 20 7e 61 0a 23 21  nerated by ~a.#!
0300: 72 36 72 73 0a 28 6c 69 62 72 61 72 79 20 7e 73  r6rs.(library ~s
0310: 0a 20 20 28 65 78 70 6f 72 74 0a 20 20 20 20 7e  .  (export.    ~
0320: 61 29 0a 20 20 28 69 6d 70 6f 72 74 20 7e 73 29  a).  (import ~s)
0330: 0a 29 0a 22 29 0a 0a 28 64 65 66 69 6e 65 20 70  .).")..(define p
0340: 72 6f 67 72 61 6d 2d 6e 61 6d 65 20 28 63 61 72  rogram-name (car
0350: 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65 29 29   (command-line))
0360: 29 0a 0a 28 66 6f 72 2d 65 61 63 68 0a 20 28 6c  )..(for-each. (l
0370: 61 6d 62 64 61 20 28 78 29 0a 20 20 20 28 6c 65  ambda (x).   (le
0380: 74 2a 20 28 28 73 72 66 69 2d 6e 75 6d 20 28 63  t* ((srfi-num (c
0390: 61 72 20 78 29 29 0a 20 20 20 20 20 20 20 20 20  ar x)).         
03a0: 20 28 6c 69 62 2d 6e 61 6d 65 20 28 63 61 64 72   (lib-name (cadr
03b0: 20 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 28   x)).          (
03c0: 65 78 70 6f 72 74 73 20 28 6c 69 73 74 2d 73 6f  exports (list-so
03d0: 72 74 20 73 79 6d 62 6f 6c 3c 3f 0a 20 20 20 20  rt symbol<?.    
03e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
03f0: 20 20 20 20 20 20 20 20 20 20 28 65 6e 76 69 72            (envir
0400: 6f 6e 6d 65 6e 74 2d 73 79 6d 62 6f 6c 73 20 28  onment-symbols (
0410: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6c 69 62 2d  environment lib-
0420: 6e 61 6d 65 29 29 29 29 0a 20 20 20 20 20 20 20  name)))).       
0430: 20 20 20 28 61 6c 69 61 73 2d 6e 61 6d 65 20 60     (alias-name `
0440: 28 73 72 66 69 20 2c 28 73 74 72 69 6e 67 2d 3e  (srfi ,(string->
0450: 73 79 6d 62 6f 6c 20 28 66 6f 72 6d 61 74 20 22  symbol (format "
0460: 3a 7e 64 22 20 73 72 66 69 2d 6e 75 6d 29 29 29  :~d" srfi-num)))
0470: 29 0a 20 20 20 20 20 20 20 20 20 20 28 6f 75 74  ).          (out
0480: 2d 66 69 6c 65 20 28 66 6f 72 6d 61 74 20 22 7e  -file (format "~
0490: 64 2e 73 6c 73 22 20 73 72 66 69 2d 6e 75 6d 29  d.sls" srfi-num)
04a0: 29 29 0a 20 20 20 20 20 28 63 6f 6e 64 0a 20 20  )).     (cond.  
04b0: 20 20 20 20 20 28 28 66 69 6c 65 2d 65 78 69 73       ((file-exis
04c0: 74 73 3f 20 6f 75 74 2d 66 69 6c 65 29 0a 20 20  ts? out-file).  
04d0: 20 20 20 20 20 20 28 70 72 69 6e 74 66 20 22 53        (printf "S
04e0: 6b 69 70 70 69 6e 67 20 7e 61 20 62 65 63 61 75  kipping ~a becau
04f0: 73 65 20 69 74 20 61 6c 72 65 61 64 79 20 65 78  se it already ex
0500: 69 73 74 73 2e 5c 6e 22 20 6f 75 74 2d 66 69 6c  ists.\n" out-fil
0510: 65 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65  e)).       (else
0520: 0a 20 20 20 20 20 20 20 20 28 63 61 6c 6c 2d 77  .        (call-w
0530: 69 74 68 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20  ith-output-file 
0540: 6f 75 74 2d 66 69 6c 65 0a 20 20 20 20 20 20 20  out-file.       
0550: 20 20 20 28 6c 61 6d 62 64 61 20 28 66 6f 70 29     (lambda (fop)
0560: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 66 70  .            (fp
0570: 72 69 6e 74 66 20 66 6f 70 20 61 6c 69 61 73 2d  rintf fop alias-
0580: 74 65 6d 70 6c 61 74 65 0a 20 20 20 20 20 20 20  template.       
0590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 72                pr
05a0: 6f 67 72 61 6d 2d 6e 61 6d 65 0a 20 20 20 20 20  ogram-name.     
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
05c0: 61 6c 69 61 73 2d 6e 61 6d 65 0a 20 20 20 20 20  alias-name.     
05d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
05e0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65  (string-interspe
05f0: 72 73 65 20 28 6d 61 70 20 73 79 6d 62 6f 6c 2d  rse (map symbol-
0600: 3e 73 74 72 69 6e 67 20 65 78 70 6f 72 74 73 29  >string exports)
0610: 20 22 5c 6e 20 20 20 20 22 29 0a 20 20 20 20 20   "\n    ").     
0620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0630: 6c 69 62 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20  lib-name))).    
0640: 20 20 20 20 28 70 72 69 6e 74 66 20 22 7e 61 5c      (printf "~a\
0650: 6e 22 20 6f 75 74 2d 66 69 6c 65 29 29 29 29 29  n" out-file)))))
0660: 0a 20 73 72 66 69 2d 6c 69 62 72 61 72 69 65 73  . srfi-libraries
0670: 2f 6d 6e 65 6d 6f 6e 69 63 73 29 0a              /mnemonics).