Artifact
c5cd13b3d23ffa994572cdc4c5a5b8bd0f1cb6a8:
- File
fmt/fmt-c.scm
— part of check-in
[80c8c83034]
at
2016-07-07 18:11:39
on branch trunk
— initial import
(user:
ovenpasta@pizzahack.eu
size: 32220)
0000: 3b 3b 3b 3b 20 66 6d 74 2d 63 2e 73 63 6d 20 2d ;;;; fmt-c.scm -
0010: 2d 20 66 6d 74 20 6d 6f 64 75 6c 65 20 66 6f 72 - fmt module for
0020: 20 65 6d 69 74 74 69 6e 67 2f 70 72 65 74 74 79 emitting/pretty
0030: 2d 70 72 69 6e 74 69 6e 67 20 43 20 63 6f 64 65 -printing C code
0040: 0a 3b 3b 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 .;;.;; Copyright
0050: 20 28 63 29 20 32 30 30 37 20 41 6c 65 78 20 53 (c) 2007 Alex S
0060: 68 69 6e 6e 2e 20 20 41 6c 6c 20 72 69 67 68 74 hinn. All right
0070: 73 20 72 65 73 65 72 76 65 64 2e 0a 3b 3b 20 42 s reserved..;; B
0080: 53 44 2d 73 74 79 6c 65 20 6c 69 63 65 6e 73 65 SD-style license
0090: 3a 20 68 74 74 70 3a 2f 2f 73 79 6e 74 68 63 6f : http://synthco
00a0: 64 65 2e 63 6f 6d 2f 6c 69 63 65 6e 73 65 2e 74 de.com/license.t
00b0: 78 74 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b xt..;;;;;;;;;;;;
00c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
00d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
00e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
00f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 ;;;;;;;;;;;;.;;
0100: 61 64 64 69 74 69 6f 6e 61 6c 20 73 74 61 74 65 additional state
0110: 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 0a 0a 28 64 information..(d
0120: 65 66 69 6e 65 20 28 66 6d 74 2d 69 6e 2d 6d 61 efine (fmt-in-ma
0130: 63 72 6f 3f 20 73 74 29 20 28 66 6d 74 2d 72 65 cro? st) (fmt-re
0140: 66 20 73 74 20 27 69 6e 2d 6d 61 63 72 6f 3f 29 f st 'in-macro?)
0150: 29 0a 28 64 65 66 69 6e 65 20 28 66 6d 74 2d 65 ).(define (fmt-e
0160: 78 70 72 65 73 73 69 6f 6e 3f 20 73 74 29 20 28 xpression? st) (
0170: 66 6d 74 2d 72 65 66 20 73 74 20 27 65 78 70 72 fmt-ref st 'expr
0180: 65 73 73 69 6f 6e 3f 29 29 0a 28 64 65 66 69 6e ession?)).(defin
0190: 65 20 28 66 6d 74 2d 72 65 74 75 72 6e 3f 20 73 e (fmt-return? s
01a0: 74 29 20 28 66 6d 74 2d 72 65 66 20 73 74 20 27 t) (fmt-ref st '
01b0: 72 65 74 75 72 6e 3f 29 29 0a 28 64 65 66 69 6e return?)).(defin
01c0: 65 20 28 66 6d 74 2d 64 65 66 61 75 6c 74 2d 74 e (fmt-default-t
01d0: 79 70 65 20 73 74 29 20 28 66 6d 74 2d 72 65 66 ype st) (fmt-ref
01e0: 20 73 74 20 27 64 65 66 61 75 6c 74 2d 74 79 70 st 'default-typ
01f0: 65 20 27 69 6e 74 29 29 0a 28 64 65 66 69 6e 65 e 'int)).(define
0200: 20 28 66 6d 74 2d 6e 65 77 6c 69 6e 65 2d 62 65 (fmt-newline-be
0210: 66 6f 72 65 2d 62 72 61 63 65 3f 20 73 74 29 20 fore-brace? st)
0220: 28 66 6d 74 2d 72 65 66 20 73 74 20 27 6e 65 77 (fmt-ref st 'new
0230: 6c 69 6e 65 2d 62 65 66 6f 72 65 2d 62 72 61 63 line-before-brac
0240: 65 3f 29 29 0a 28 64 65 66 69 6e 65 20 28 66 6d e?)).(define (fm
0250: 74 2d 62 72 61 63 65 6c 65 73 73 2d 62 6f 64 69 t-braceless-bodi
0260: 65 73 3f 20 73 74 29 20 28 66 6d 74 2d 72 65 66 es? st) (fmt-ref
0270: 20 73 74 20 27 62 72 61 63 65 6c 65 73 73 2d 62 st 'braceless-b
0280: 6f 64 69 65 73 3f 29 29 0a 28 64 65 66 69 6e 65 odies?)).(define
0290: 20 28 66 6d 74 2d 6e 6f 6e 2d 73 70 61 63 65 64 (fmt-non-spaced
02a0: 2d 6f 70 73 3f 20 73 74 29 20 28 66 6d 74 2d 72 -ops? st) (fmt-r
02b0: 65 66 20 73 74 20 27 6e 6f 6e 2d 73 70 61 63 65 ef st 'non-space
02c0: 64 2d 6f 70 73 3f 29 29 0a 28 64 65 66 69 6e 65 d-ops?)).(define
02d0: 20 28 66 6d 74 2d 6e 6f 2d 77 72 61 70 3f 20 73 (fmt-no-wrap? s
02e0: 74 29 20 28 66 6d 74 2d 72 65 66 20 73 74 20 27 t) (fmt-ref st '
02f0: 6e 6f 2d 77 72 61 70 3f 29 29 0a 28 64 65 66 69 no-wrap?)).(defi
0300: 6e 65 20 28 66 6d 74 2d 69 6e 64 65 6e 74 2d 73 ne (fmt-indent-s
0310: 70 61 63 65 20 73 74 29 20 28 66 6d 74 2d 72 65 pace st) (fmt-re
0320: 66 20 73 74 20 27 69 6e 64 65 6e 74 2d 73 70 61 f st 'indent-spa
0330: 63 65 29 29 0a 28 64 65 66 69 6e 65 20 28 66 6d ce)).(define (fm
0340: 74 2d 73 77 69 74 63 68 2d 69 6e 64 65 6e 74 2d t-switch-indent-
0350: 73 70 61 63 65 20 73 74 29 20 28 66 6d 74 2d 72 space st) (fmt-r
0360: 65 66 20 73 74 20 27 73 77 69 74 63 68 2d 69 6e ef st 'switch-in
0370: 64 65 6e 74 2d 73 70 61 63 65 29 29 0a 28 64 65 dent-space)).(de
0380: 66 69 6e 65 20 28 66 6d 74 2d 6f 70 20 73 74 29 fine (fmt-op st)
0390: 20 28 66 6d 74 2d 72 65 66 20 73 74 20 27 6f 70 (fmt-ref st 'op
03a0: 20 27 73 74 6d 74 29 29 0a 28 64 65 66 69 6e 65 'stmt)).(define
03b0: 20 28 66 6d 74 2d 67 65 6e 20 73 74 29 20 28 66 (fmt-gen st) (f
03c0: 6d 74 2d 72 65 66 20 73 74 20 27 67 65 6e 29 29 mt-ref st 'gen))
03d0: 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 69 6e 2d ..(define (c-in-
03e0: 65 78 70 72 20 70 72 6f 63 29 20 28 66 6d 74 2d expr proc) (fmt-
03f0: 6c 65 74 20 27 65 78 70 72 65 73 73 69 6f 6e 3f let 'expression?
0400: 20 23 74 20 70 72 6f 63 29 29 0a 28 64 65 66 69 #t proc)).(defi
0410: 6e 65 20 28 63 2d 69 6e 2d 73 74 6d 74 20 70 72 ne (c-in-stmt pr
0420: 6f 63 29 20 28 66 6d 74 2d 6c 65 74 20 27 65 78 oc) (fmt-let 'ex
0430: 70 72 65 73 73 69 6f 6e 3f 20 23 66 20 70 72 6f pression? #f pro
0440: 63 29 29 0a 28 64 65 66 69 6e 65 20 28 63 2d 69 c)).(define (c-i
0450: 6e 2d 74 65 73 74 20 70 72 6f 63 29 20 28 66 6d n-test proc) (fm
0460: 74 2d 6c 65 74 20 27 69 6e 2d 63 6f 6e 64 3f 20 t-let 'in-cond?
0470: 23 74 20 28 63 2d 69 6e 2d 65 78 70 72 20 70 72 #t (c-in-expr pr
0480: 6f 63 29 29 29 0a 28 64 65 66 69 6e 65 20 28 63 oc))).(define (c
0490: 2d 77 69 74 68 2d 6f 70 20 6f 70 20 70 72 6f 63 -with-op op proc
04a0: 29 20 28 66 6d 74 2d 6c 65 74 20 27 6f 70 20 6f ) (fmt-let 'op o
04b0: 70 20 70 72 6f 63 29 29 0a 0a 3b 3b 3b 3b 3b 3b p proc))..;;;;;;
04c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
04d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
04e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
04f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0500: 3b 3b 0a 3b 3b 20 62 65 20 73 6d 61 72 74 20 61 ;;.;; be smart a
0510: 62 6f 75 74 20 6f 70 65 72 61 74 6f 72 20 70 72 bout operator pr
0520: 65 63 65 64 65 6e 63 65 0a 0a 28 64 65 66 69 6e ecedence..(defin
0530: 65 20 28 63 2d 6f 70 2d 70 72 65 63 65 64 65 6e e (c-op-preceden
0540: 63 65 20 78 29 0a 20 20 28 69 66 20 28 73 74 72 ce x). (if (str
0550: 69 6e 67 3f 20 78 29 0a 20 20 20 20 20 20 28 63 ing? x). (c
0560: 6f 6e 64 0a 20 20 20 20 20 20 20 20 28 28 6f 72 ond. ((or
0570: 20 28 73 74 72 69 6e 67 3d 3f 20 78 20 22 2e 22 (string=? x "."
0580: 29 20 28 73 74 72 69 6e 67 3d 3f 20 78 20 22 2d ) (string=? x "-
0590: 3e 22 29 29 20 31 30 29 0a 20 20 20 20 20 20 20 >")) 10).
05a0: 20 28 28 6f 72 20 28 73 74 72 69 6e 67 3d 3f 20 ((or (string=?
05b0: 78 20 22 2b 2b 22 29 20 28 73 74 72 69 6e 67 3d x "++") (string=
05c0: 3f 20 78 20 22 2d 2d 22 29 29 20 32 30 29 0a 20 ? x "--")) 20).
05d0: 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d ((string=
05e0: 3f 20 78 20 22 7c 22 29 20 36 35 29 0a 20 20 20 ? x "|") 65).
05f0: 20 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 ((string=?
0600: 78 20 22 7c 7c 22 29 20 37 35 29 0a 20 20 20 20 x "||") 75).
0610: 20 20 20 20 28 28 73 74 72 69 6e 67 3d 3f 20 78 ((string=? x
0620: 20 22 7c 3d 22 29 20 38 35 29 0a 20 20 20 20 20 "|=") 85).
0630: 20 20 20 28 28 6f 72 20 28 73 74 72 69 6e 67 3d ((or (string=
0640: 3f 20 78 20 22 2b 3d 22 29 20 28 73 74 72 69 6e ? x "+=") (strin
0650: 67 3d 3f 20 78 20 22 2d 3d 22 29 29 20 38 35 29 g=? x "-=")) 85)
0660: 0a 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 39 . (else 9
0670: 35 29 29 0a 20 20 20 20 20 20 28 63 61 73 65 20 5)). (case
0680: 78 0a 20 20 20 20 20 20 20 20 3b 3b 28 28 7c 3a x. ;;((|:
0690: 3a 7c 29 20 35 29 20 3b 20 43 2b 2b 0a 20 20 20 :|) 5) ; C++.
06a0: 20 20 20 20 20 28 28 70 61 72 65 6e 20 62 72 61 ((paren bra
06b0: 63 6b 65 74 29 20 35 29 0a 20 20 20 20 20 20 20 cket) 5).
06c0: 20 28 28 64 6f 74 20 61 72 72 6f 77 20 70 6f 73 ((dot arrow pos
06d0: 74 2d 64 65 63 72 65 6d 65 6e 74 20 70 6f 73 74 t-decrement post
06e0: 2d 69 6e 63 72 65 6d 65 6e 74 29 20 31 30 29 0a -increment) 10).
06f0: 20 20 20 20 20 20 20 20 28 28 2a 2a 29 20 31 35 ((**) 15
0700: 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 )
0710: 20 20 20 20 20 20 20 20 3b 20 50 65 72 6c 0a 20 ; Perl.
0720: 20 20 20 20 20 20 20 28 28 75 6e 61 72 79 2b 20 ((unary+
0730: 75 6e 61 72 79 2d 20 21 20 7e 20 63 61 73 74 20 unary- ! ~ cast
0740: 75 6e 61 72 79 2d 2a 20 75 6e 61 72 79 2d 26 20 unary-* unary-&
0750: 73 69 7a 65 6f 66 29 20 32 30 29 20 3b 20 2b 2b sizeof) 20) ; ++
0760: 20 2d 2d 0a 20 20 20 20 20 20 20 20 28 28 3d 7e --. ((=~
0770: 20 21 7e 29 20 32 35 29 20 20 20 20 20 20 20 20 !~) 25)
0780: 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 50 65 ; Pe
0790: 72 6c 0a 20 20 20 20 20 20 20 20 28 28 2a 20 2f rl. ((* /
07a0: 20 25 29 20 33 30 29 0a 20 20 20 20 20 20 20 20 %) 30).
07b0: 28 28 2b 20 2d 29 20 33 35 29 0a 20 20 20 20 20 ((+ -) 35).
07c0: 20 20 20 28 28 3c 3c 20 3e 3e 29 20 34 30 29 0a ((<< >>) 40).
07d0: 20 20 20 20 20 20 20 20 28 28 3c 20 3e 20 3c 3d ((< > <=
07e0: 20 3e 3d 29 20 34 35 29 0a 20 20 20 20 20 20 20 >=) 45).
07f0: 20 28 28 6c 74 20 67 74 20 6c 65 20 67 65 29 20 ((lt gt le ge)
0800: 34 35 29 20 20 20 20 20 20 20 20 20 20 20 20 20 45)
0810: 20 3b 20 50 65 72 6c 0a 20 20 20 20 20 20 20 20 ; Perl.
0820: 28 28 3d 3d 20 21 3d 29 20 35 30 29 0a 20 20 20 ((== !=) 50).
0830: 20 20 20 20 20 28 28 65 71 20 6e 65 20 63 6d 70 ((eq ne cmp
0840: 29 20 35 30 29 20 20 20 20 20 20 20 20 20 20 20 ) 50)
0850: 20 20 20 20 20 3b 20 50 65 72 6c 0a 20 20 20 20 ; Perl.
0860: 20 20 20 20 28 28 26 29 20 35 35 29 0a 20 20 20 ((&) 55).
0870: 20 20 20 20 20 28 28 5e 29 20 36 30 29 0a 20 20 ((^) 60).
0880: 20 20 20 20 20 20 3b 3b 28 28 7c 5c 7c 7c 29 20 ;;((|\||)
0890: 36 35 29 0a 20 20 20 20 20 20 20 20 28 28 26 26 65). ((&&
08a0: 29 20 37 30 29 0a 20 20 20 20 20 20 20 20 3b 3b ) 70). ;;
08b0: 28 28 7c 5c 7c 5c 7c 7c 29 20 37 35 29 0a 20 20 ((|\|\||) 75).
08c0: 20 20 20 20 20 20 3b 3b 28 28 2e 2e 20 2e 2e 2e ;;((.. ...
08d0: 29 20 37 37 29 20 20 20 20 20 20 20 20 20 20 20 ) 77)
08e0: 20 20 20 20 20 20 20 20 3b 20 50 65 72 6c 0a 20 ; Perl.
08f0: 20 20 20 20 20 20 20 28 28 3f 29 20 38 30 29 0a ((?) 80).
0900: 20 20 20 20 20 20 20 20 28 28 3d 20 2a 3d 20 2f ((= *= /
0910: 3d 20 25 3d 20 26 3d 20 5e 3d 20 3c 3c 3d 20 3e = %= &= ^= <<= >
0920: 3e 3d 29 20 38 35 29 20 3b 20 7c 5c 7c 3d 7c 20 >=) 85) ; |\|=|
0930: 3b 20 20 2b 3d 20 2d 3d 0a 20 20 20 20 20 20 20 ; += -=.
0940: 20 28 28 63 6f 6d 6d 61 29 20 39 30 29 0a 20 20 ((comma) 90).
0950: 20 20 20 20 20 20 28 28 3d 3e 29 20 39 30 29 20 ((=>) 90)
0960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0970: 20 20 20 20 20 20 3b 20 50 65 72 6c 0a 20 20 20 ; Perl.
0980: 20 20 20 20 20 28 28 6e 6f 74 29 20 39 32 29 20 ((not) 92)
0990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09a0: 20 20 20 20 20 3b 20 50 65 72 6c 0a 20 20 20 20 ; Perl.
09b0: 20 20 20 20 28 28 61 6e 64 29 20 39 33 29 20 20 ((and) 93)
09c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
09d0: 20 20 20 20 3b 20 50 65 72 6c 0a 20 20 20 20 20 ; Perl.
09e0: 20 20 20 28 28 6f 72 20 78 6f 72 29 20 39 34 29 ((or xor) 94)
09f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a00: 20 20 20 3b 20 50 65 72 6c 0a 20 20 20 20 20 20 ; Perl.
0a10: 20 20 28 65 6c 73 65 20 39 35 29 29 29 29 0a 0a (else 95))))..
0a20: 28 64 65 66 69 6e 65 20 28 63 2d 6f 70 3c 20 78 (define (c-op< x
0a30: 20 79 29 20 28 3c 20 28 63 2d 6f 70 2d 70 72 65 y) (< (c-op-pre
0a40: 63 65 64 65 6e 63 65 20 78 29 20 28 63 2d 6f 70 cedence x) (c-op
0a50: 2d 70 72 65 63 65 64 65 6e 63 65 20 79 29 29 29 -precedence y)))
0a60: 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 70 61 72 ..(define (c-par
0a70: 65 6e 20 78 29 20 28 63 61 74 20 22 28 22 20 78 en x) (cat "(" x
0a80: 20 22 29 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 ")"))..(define
0a90: 28 63 2d 6d 61 79 62 65 2d 70 61 72 65 6e 20 6f (c-maybe-paren o
0aa0: 70 20 78 29 0a 20 20 28 6c 61 6d 62 64 61 20 28 p x). (lambda (
0ab0: 73 74 29 0a 20 20 20 20 28 28 66 6d 74 2d 6c 65 st). ((fmt-le
0ac0: 74 20 27 6f 70 20 6f 70 0a 20 20 20 20 20 20 20 t 'op op.
0ad0: 20 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 (if (or (
0ae0: 66 6d 74 2d 69 6e 2d 6d 61 63 72 6f 3f 20 73 74 fmt-in-macro? st
0af0: 29 20 28 63 2d 6f 70 3c 20 28 66 6d 74 2d 6f 70 ) (c-op< (fmt-op
0b00: 20 73 74 29 20 6f 70 29 29 0a 20 20 20 20 20 20 st) op)).
0b10: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 2d 70 (c-p
0b20: 61 72 65 6e 20 78 29 0a 20 20 20 20 20 20 20 20 aren x).
0b30: 20 20 20 20 20 20 20 20 20 20 78 29 29 0a 20 20 x)).
0b40: 20 20 20 73 74 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b st)))..;;;;;;
0b50: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0b60: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0b70: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0b80: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0b90: 3b 3b 0a 3b 3b 20 64 65 66 61 75 6c 74 20 6c 69 ;;.;; default li
0ba0: 74 65 72 61 6c 73 20 77 72 69 74 65 72 0a 0a 28 terals writer..(
0bb0: 64 65 66 69 6e 65 20 28 63 2d 63 6f 6e 74 72 6f define (c-contro
0bc0: 6c 2d 6f 70 65 72 61 74 6f 72 3f 20 78 29 0a 20 l-operator? x).
0bd0: 20 28 6d 65 6d 71 20 78 20 27 28 69 66 20 77 68 (memq x '(if wh
0be0: 69 6c 65 20 73 77 69 74 63 68 20 72 65 70 65 61 ile switch repea
0bf0: 74 20 64 6f 20 66 6f 72 20 66 75 6e 20 62 65 67 t do for fun beg
0c00: 69 6e 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 in)))..(define (
0c10: 63 2d 6c 69 74 65 72 61 6c 3f 20 78 29 0a 20 20 c-literal? x).
0c20: 28 6f 72 20 28 6e 75 6d 62 65 72 3f 20 78 29 20 (or (number? x)
0c30: 28 73 74 72 69 6e 67 3f 20 78 29 20 28 63 68 61 (string? x) (cha
0c40: 72 3f 20 78 29 20 28 62 6f 6f 6c 65 61 6e 3f 20 r? x) (boolean?
0c50: 78 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 x)))..(define (c
0c60: 68 61 72 2d 3e 63 2d 63 68 61 72 20 63 29 0a 20 har->c-char c).
0c70: 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 (string-append
0c80: 22 27 22 20 28 63 2d 65 73 63 61 70 65 2d 63 68 "'" (c-escape-ch
0c90: 61 72 20 63 20 23 5c 27 29 20 22 27 22 29 29 0a ar c #\') "'")).
0ca0: 0a 28 64 65 66 69 6e 65 20 28 63 2d 65 73 63 61 .(define (c-esca
0cb0: 70 65 2d 63 68 61 72 20 63 20 71 75 6f 74 65 2d pe-char c quote-
0cc0: 63 68 61 72 29 0a 20 20 28 6c 65 74 20 28 28 6e char). (let ((n
0cd0: 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
0ce0: 63 29 29 29 0a 20 20 20 20 28 69 66 20 28 3c 3d c))). (if (<=
0cf0: 20 33 32 20 6e 20 31 32 36 29 0a 20 20 20 20 20 32 n 126).
0d00: 20 20 20 28 69 66 20 28 6f 72 20 28 65 71 76 3f (if (or (eqv?
0d10: 20 63 20 71 75 6f 74 65 2d 63 68 61 72 29 20 28 c quote-char) (
0d20: 65 71 76 3f 20 63 20 23 5c 5c 29 29 0a 20 20 20 eqv? c #\\)).
0d30: 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
0d40: 20 23 5c 5c 20 63 29 0a 20 20 20 20 20 20 20 20 #\\ c).
0d50: 20 20 20 20 28 73 74 72 69 6e 67 20 63 29 29 0a (string c)).
0d60: 20 20 20 20 20 20 20 20 28 63 61 73 65 20 6e 0a (case n.
0d70: 20 20 20 20 20 20 20 20 20 20 28 28 37 29 20 22 ((7) "
0d80: 5c 5c 61 22 29 20 28 28 38 29 20 22 5c 5c 62 22 \\a") ((8) "\\b"
0d90: 29 20 28 28 39 29 20 22 5c 5c 74 22 29 20 28 28 ) ((9) "\\t") ((
0da0: 31 30 29 20 22 5c 5c 6e 22 29 0a 20 20 20 20 20 10) "\\n").
0db0: 20 20 20 20 20 28 28 31 31 29 20 22 5c 5c 76 22 ((11) "\\v"
0dc0: 29 20 28 28 31 32 29 20 22 5c 5c 66 22 29 20 28 ) ((12) "\\f") (
0dd0: 28 31 33 29 20 22 5c 5c 72 22 29 0a 20 20 20 20 (13) "\\r").
0de0: 20 20 20 20 20 20 28 65 6c 73 65 20 28 73 74 72 (else (str
0df0: 69 6e 67 2d 61 70 70 65 6e 64 20 22 5c 5c 78 22 ing-append "\\x"
0e00: 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 (number->string
0e10: 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
0e20: 63 29 20 31 36 29 29 29 29 29 29 29 0a 0a 28 64 c) 16)))))))..(d
0e30: 65 66 69 6e 65 20 28 63 2d 66 6f 72 6d 61 74 2d efine (c-format-
0e40: 6e 75 6d 62 65 72 20 78 29 0a 20 20 28 69 66 20 number x). (if
0e50: 28 61 6e 64 20 28 69 6e 74 65 67 65 72 3f 20 78 (and (integer? x
0e60: 29 20 28 65 78 61 63 74 3f 20 78 29 29 0a 20 20 ) (exact? x)).
0e70: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 29 (lambda (st)
0e80: 0a 20 20 20 20 20 20 20 20 28 28 63 61 73 65 20 . ((case
0e90: 28 66 6d 74 2d 72 61 64 69 78 20 73 74 29 0a 20 (fmt-radix st).
0ea0: 20 20 20 20 20 20 20 20 20 20 28 28 31 36 29 20 ((16)
0eb0: 28 63 61 74 20 22 30 78 22 20 28 73 74 72 69 6e (cat "0x" (strin
0ec0: 67 2d 75 70 63 61 73 65 20 28 6e 75 6d 62 65 72 g-upcase (number
0ed0: 2d 3e 73 74 72 69 6e 67 20 78 20 31 36 29 29 29 ->string x 16)))
0ee0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 28 38 ). ((8
0ef0: 29 20 28 63 61 74 20 22 30 22 20 28 6e 75 6d 62 ) (cat "0" (numb
0f00: 65 72 2d 3e 73 74 72 69 6e 67 20 78 20 38 29 29 er->string x 8))
0f10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 6c ). (el
0f20: 73 65 20 28 64 73 70 20 28 6e 75 6d 62 65 72 2d se (dsp (number-
0f30: 3e 73 74 72 69 6e 67 20 78 29 29 29 29 0a 20 20 >string x)))).
0f40: 20 20 20 20 20 20 20 73 74 29 29 0a 20 20 20 20 st)).
0f50: 20 20 28 64 73 70 20 28 6e 75 6d 62 65 72 2d 3e (dsp (number->
0f60: 73 74 72 69 6e 67 20 78 29 29 29 29 0a 0a 28 64 string x))))..(d
0f70: 65 66 69 6e 65 20 28 63 2d 66 6f 72 6d 61 74 2d efine (c-format-
0f80: 73 74 72 69 6e 67 20 78 29 0a 20 20 28 6c 61 6d string x). (lam
0f90: 62 64 61 20 28 73 74 29 20 28 28 63 61 74 20 23 bda (st) ((cat #
0fa0: 5c 22 20 28 61 70 70 6c 79 2d 63 61 74 20 28 63 \" (apply-cat (c
0fb0: 2d 73 74 72 69 6e 67 2d 65 73 63 61 70 65 64 20 -string-escaped
0fc0: 78 29 29 20 23 5c 22 29 20 73 74 29 29 29 0a 0a x)) #\") st)))..
0fd0: 28 64 65 66 69 6e 65 20 28 63 2d 73 74 72 69 6e (define (c-strin
0fe0: 67 2d 65 73 63 61 70 65 64 20 78 29 0a 20 20 28 g-escaped x). (
0ff0: 6c 65 74 20 6c 6f 6f 70 20 28 28 70 61 72 74 73 let loop ((parts
1000: 20 27 28 29 29 20 28 69 64 78 20 28 73 74 72 69 '()) (idx (stri
1010: 6e 67 2d 6c 65 6e 67 74 68 20 78 29 29 29 0a 20 ng-length x))).
1020: 20 20 20 28 63 6f 6e 64 20 28 28 73 74 72 69 6e (cond ((strin
1030: 67 2d 69 6e 64 65 78 2d 72 69 67 68 74 20 78 20 g-index-right x
1040: 63 2d 6e 65 65 64 73 2d 73 74 72 69 6e 67 2d 65 c-needs-string-e
1050: 73 63 61 70 65 3f 20 30 20 69 64 78 29 0a 20 20 scape? 0 idx).
1060: 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c 61 6d => (lam
1070: 62 64 61 20 28 73 70 65 63 69 61 6c 2d 69 64 78 bda (special-idx
1080: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1090: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 73 20 28 63 (loop (cons (c
10a0: 2d 65 73 63 61 70 65 2d 63 68 61 72 20 28 73 74 -escape-char (st
10b0: 72 69 6e 67 2d 72 65 66 20 78 20 73 70 65 63 69 ring-ref x speci
10c0: 61 6c 2d 69 64 78 29 20 23 5c 22 29 0a 20 20 20 al-idx) #\").
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 63 6f 6e 73 20 28 (cons (
10f0: 73 75 62 73 74 72 69 6e 67 2f 73 68 61 72 65 64 substring/shared
1100: 20 78 20 28 2b 20 73 70 65 63 69 61 6c 2d 69 64 x (+ special-id
1110: 78 20 31 29 20 69 64 78 29 0a 20 20 20 20 20 20 x 1) idx).
1120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1130: 20 20 20 20 20 20 20 20 20 20 20 20 70 61 72 74 part
1140: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
1150: 20 20 20 20 20 20 20 20 20 20 73 70 65 63 69 61 specia
1160: 6c 2d 69 64 78 29 29 29 0a 20 20 20 20 20 20 20 l-idx))).
1170: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else.
1180: 20 20 20 20 28 63 6f 6e 73 20 28 73 75 62 73 74 (cons (subst
1190: 72 69 6e 67 2f 73 68 61 72 65 64 20 78 20 30 20 ring/shared x 0
11a0: 69 64 78 29 20 70 61 72 74 73 29 29 29 29 29 0a idx) parts))))).
11b0: 0a 28 64 65 66 69 6e 65 20 28 63 2d 6e 65 65 64 .(define (c-need
11c0: 73 2d 73 74 72 69 6e 67 2d 65 73 63 61 70 65 3f s-string-escape?
11d0: 20 63 29 0a 20 20 28 69 66 20 28 3c 3d 20 33 32 c). (if (<= 32
11e0: 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
11f0: 63 29 20 31 32 37 29 20 28 6d 65 6d 76 20 63 20 c) 127) (memv c
1200: 27 28 23 5c 22 20 23 5c 5c 29 29 20 23 74 29 29 '(#\" #\\)) #t))
1210: 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 73 69 6d ..(define (c-sim
1220: 70 6c 65 2d 6c 69 74 65 72 61 6c 20 78 29 0a 20 ple-literal x).
1230: 20 28 63 2d 77 72 61 70 2d 73 74 6d 74 0a 20 20 (c-wrap-stmt.
1240: 20 28 63 6f 6e 64 20 28 28 63 68 61 72 3f 20 78 (cond ((char? x
1250: 29 20 28 64 73 70 20 28 63 68 61 72 2d 3e 63 2d ) (dsp (char->c-
1260: 63 68 61 72 20 78 29 29 29 0a 20 20 20 20 20 20 char x))).
1270: 20 20 20 28 28 62 6f 6f 6c 65 61 6e 3f 20 78 29 ((boolean? x)
1280: 20 28 64 73 70 20 28 69 66 20 78 20 22 31 22 20 (dsp (if x "1"
1290: 22 30 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 "0"))).
12a0: 28 28 6e 75 6d 62 65 72 3f 20 78 29 20 28 63 2d ((number? x) (c-
12b0: 66 6f 72 6d 61 74 2d 6e 75 6d 62 65 72 20 78 29 format-number x)
12c0: 29 0a 20 20 20 20 20 20 20 20 20 28 28 73 74 72 ). ((str
12d0: 69 6e 67 3f 20 78 29 20 28 63 2d 66 6f 72 6d 61 ing? x) (c-forma
12e0: 74 2d 73 74 72 69 6e 67 20 78 29 29 0a 20 20 20 t-string x)).
12f0: 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 78 29 ((null? x)
1300: 20 28 64 73 70 20 22 4e 55 4c 4c 22 29 29 0a 20 (dsp "NULL")).
1310: 20 20 20 20 20 20 20 20 28 28 65 6f 66 2d 6f 62 ((eof-ob
1320: 6a 65 63 74 3f 20 78 29 20 28 64 73 70 20 22 45 ject? x) (dsp "E
1330: 4f 46 22 29 29 0a 20 20 20 20 20 20 20 20 20 28 OF")). (
1340: 65 6c 73 65 20 28 64 73 70 20 28 77 72 69 74 65 else (dsp (write
1350: 2d 74 6f 2d 73 74 72 69 6e 67 20 78 29 29 29 29 -to-string x))))
1360: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 6c ))..(define (c-l
1370: 69 74 65 72 61 6c 20 78 29 0a 20 20 28 6c 61 6d iteral x). (lam
1380: 62 64 61 20 28 73 74 29 0a 20 20 20 20 28 28 69 bda (st). ((i
1390: 66 20 28 61 6e 64 20 28 66 6d 74 2d 69 6e 2d 6d f (and (fmt-in-m
13a0: 61 63 72 6f 3f 20 73 74 29 20 28 63 2d 6f 70 3c acro? st) (c-op<
13b0: 20 27 70 61 72 65 6e 20 28 66 6d 74 2d 6f 70 20 'paren (fmt-op
13c0: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
13d0: 20 20 20 28 6e 6f 74 20 28 63 2d 6c 69 74 65 72 (not (c-liter
13e0: 61 6c 3f 20 78 29 29 29 0a 20 20 20 20 20 20 20 al? x))).
13f0: 20 20 28 63 2d 70 61 72 65 6e 20 28 63 2d 73 69 (c-paren (c-si
1400: 6d 70 6c 65 2d 6c 69 74 65 72 61 6c 20 78 29 29 mple-literal x))
1410: 0a 20 20 20 20 20 20 20 20 20 28 63 2d 73 69 6d . (c-sim
1420: 70 6c 65 2d 6c 69 74 65 72 61 6c 20 78 29 29 0a ple-literal x)).
1430: 20 20 20 20 20 73 74 29 29 29 0a 0a 3b 3b 3b 3b st)))..;;;;
1440: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1450: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1460: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1470: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1480: 3b 3b 3b 3b 0a 3b 3b 20 64 65 66 61 75 6c 74 20 ;;;;.;; default
1490: 65 78 70 72 65 73 73 69 6f 6e 20 67 65 6e 65 72 expression gener
14a0: 61 74 6f 72 0a 0a 28 64 65 66 69 6e 65 20 28 63 ator..(define (c
14b0: 2d 65 78 70 72 2f 73 65 78 70 20 78 29 0a 20 20 -expr/sexp x).
14c0: 28 69 66 20 28 70 72 6f 63 65 64 75 72 65 3f 20 (if (procedure?
14d0: 78 29 0a 20 20 20 20 20 20 78 0a 20 20 20 20 20 x). x.
14e0: 20 28 6c 61 6d 62 64 61 20 28 73 74 29 0a 20 20 (lambda (st).
14f0: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
1500: 20 20 20 20 20 28 28 70 61 69 72 3f 20 78 29 0a ((pair? x).
1510: 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 20 (case
1520: 28 63 61 72 20 78 29 0a 20 20 20 20 20 20 20 20 (car x).
1530: 20 20 20 20 28 28 69 66 29 20 28 28 61 70 70 6c ((if) ((appl
1540: 79 20 63 2d 69 66 20 28 63 64 72 20 78 29 29 20 y c-if (cdr x))
1550: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
1560: 20 28 28 66 6f 72 29 20 28 28 61 70 70 6c 79 20 ((for) ((apply
1570: 63 2d 66 6f 72 20 28 63 64 72 20 78 29 29 20 73 c-for (cdr x)) s
1580: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
1590: 28 28 77 68 69 6c 65 29 20 28 28 61 70 70 6c 79 ((while) ((apply
15a0: 20 63 2d 77 68 69 6c 65 20 28 63 64 72 20 78 29 c-while (cdr x)
15b0: 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 ) st)).
15c0: 20 20 20 28 28 73 77 69 74 63 68 29 20 28 28 61 ((switch) ((a
15d0: 70 70 6c 79 20 63 2d 73 77 69 74 63 68 20 28 63 pply c-switch (c
15e0: 64 72 20 78 29 29 20 73 74 29 29 0a 20 20 20 20 dr x)) st)).
15f0: 20 20 20 20 20 20 20 20 28 28 63 61 73 65 29 20 ((case)
1600: 28 28 61 70 70 6c 79 20 63 2d 63 61 73 65 20 28 ((apply c-case (
1610: 63 64 72 20 78 29 29 20 73 74 29 29 0a 20 20 20 cdr x)) st)).
1620: 20 20 20 20 20 20 20 20 20 28 28 63 61 73 65 2f ((case/
1630: 66 61 6c 6c 74 68 72 6f 75 67 68 29 20 28 28 61 fallthrough) ((a
1640: 70 70 6c 79 20 63 2d 63 61 73 65 2f 66 61 6c 6c pply c-case/fall
1650: 74 68 72 6f 75 67 68 20 28 63 64 72 20 78 29 29 through (cdr x))
1660: 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 st)).
1670: 20 20 28 28 64 65 66 61 75 6c 74 29 20 28 28 61 ((default) ((a
1680: 70 70 6c 79 20 63 2d 64 65 66 61 75 6c 74 20 28 pply c-default (
1690: 63 64 72 20 78 29 29 20 73 74 29 29 0a 20 20 20 cdr x)) st)).
16a0: 20 20 20 20 20 20 20 20 20 28 28 62 72 65 61 6b ((break
16b0: 29 20 28 63 2d 62 72 65 61 6b 20 73 74 29 29 0a ) (c-break st)).
16c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 6f ((co
16d0: 6e 74 69 6e 75 65 29 20 28 63 2d 63 6f 6e 74 69 ntinue) (c-conti
16e0: 6e 75 65 20 73 74 29 29 0a 20 20 20 20 20 20 20 nue st)).
16f0: 20 20 20 20 20 28 28 72 65 74 75 72 6e 29 20 28 ((return) (
1700: 28 61 70 70 6c 79 20 63 2d 72 65 74 75 72 6e 20 (apply c-return
1710: 28 63 64 72 20 78 29 29 20 73 74 29 29 0a 20 20 (cdr x)) st)).
1720: 20 20 20 20 20 20 20 20 20 20 28 28 67 6f 74 6f ((goto
1730: 29 20 28 28 61 70 70 6c 79 20 63 2d 67 6f 74 6f ) ((apply c-goto
1740: 20 28 63 64 72 20 78 29 29 20 73 74 29 29 0a 20 (cdr x)) st)).
1750: 20 20 20 20 20 20 20 20 20 20 20 28 28 74 79 70 ((typ
1760: 65 64 65 66 29 20 28 28 61 70 70 6c 79 20 63 2d edef) ((apply c-
1770: 74 79 70 65 64 65 66 20 28 63 64 72 20 78 29 29 typedef (cdr x))
1780: 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 st)).
1790: 20 20 28 28 73 74 72 75 63 74 20 75 6e 69 6f 6e ((struct union
17a0: 20 63 6c 61 73 73 29 20 28 28 61 70 70 6c 79 20 class) ((apply
17b0: 63 2d 73 74 72 75 63 74 2f 61 75 78 20 78 29 20 c-struct/aux x)
17c0: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
17d0: 20 28 28 65 6e 75 6d 29 20 28 28 61 70 70 6c 79 ((enum) ((apply
17e0: 20 63 2d 65 6e 75 6d 20 28 63 64 72 20 78 29 29 c-enum (cdr x))
17f0: 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 st)).
1800: 20 20 28 28 69 6e 6c 69 6e 65 20 61 75 74 6f 20 ((inline auto
1810: 72 65 73 74 72 69 63 74 20 72 65 67 69 73 74 65 restrict registe
1820: 72 20 76 6f 6c 61 74 69 6c 65 20 65 78 74 65 72 r volatile exter
1830: 6e 20 73 74 61 74 69 63 29 0a 20 20 20 20 20 20 n static).
1840: 20 20 20 20 20 20 20 28 28 63 61 74 20 28 63 61 ((cat (ca
1850: 72 20 78 29 20 22 20 22 20 28 61 70 70 6c 79 2d r x) " " (apply-
1860: 63 61 74 20 28 63 64 72 20 78 29 29 29 20 73 74 cat (cdr x))) st
1870: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 3b )). ;
1880: 3b 20 6e 6f 6e 20 43 2d 6b 65 79 77 6f 72 64 73 ; non C-keywords
1890: 20 6d 75 73 74 20 68 61 76 65 20 73 6f 6d 65 20 must have some
18a0: 63 68 61 72 61 63 74 65 72 20 69 6e 76 61 6c 69 character invali
18b0: 64 20 69 6e 20 61 20 43 0a 20 20 20 20 20 20 20 d in a C.
18c0: 20 20 20 20 20 3b 3b 20 69 64 65 6e 74 69 66 69 ;; identifi
18d0: 65 72 20 74 6f 20 61 76 6f 69 64 20 63 6f 6e 66 er to avoid conf
18e0: 6c 69 63 74 73 20 2d 20 62 79 20 64 65 66 61 75 licts - by defau
18f0: 6c 74 20 77 65 20 70 72 65 66 69 78 20 25 0a 20 lt we prefix %.
1900: 20 20 20 20 20 20 20 20 20 20 20 28 28 76 65 63 ((vec
1910: 74 6f 72 2d 72 65 66 29 0a 20 20 20 20 20 20 20 tor-ref).
1920: 20 20 20 20 20 20 28 28 63 2d 77 72 61 70 2d 73 ((c-wrap-s
1930: 74 6d 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 tmt.
1940: 20 20 20 28 63 61 74 20 28 63 2d 65 78 70 72 20 (cat (c-expr
1950: 28 63 61 64 72 20 78 29 29 20 22 5b 22 20 28 63 (cadr x)) "[" (c
1960: 2d 65 78 70 72 20 28 63 61 64 64 72 20 78 29 29 -expr (caddr x))
1970: 20 22 5d 22 29 29 0a 20 20 20 20 20 20 20 20 20 "]")).
1980: 20 20 20 20 20 73 74 29 29 0a 20 20 20 20 20 20 st)).
1990: 20 20 20 20 20 20 28 28 76 65 63 74 6f 72 2d 73 ((vector-s
19a0: 65 74 21 29 0a 20 20 20 20 20 20 20 20 20 20 20 et!).
19b0: 20 20 28 28 63 3d 20 28 63 2d 69 6e 2d 65 78 70 ((c= (c-in-exp
19c0: 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
19d0: 20 20 20 20 20 28 63 61 74 20 28 63 2d 65 78 70 (cat (c-exp
19e0: 72 20 28 63 61 64 72 20 78 29 29 20 22 5b 22 20 r (cadr x)) "["
19f0: 28 63 2d 65 78 70 72 20 28 63 61 64 64 72 20 78 (c-expr (caddr x
1a00: 29 29 20 22 5d 22 29 29 0a 20 20 20 20 20 20 20 )) "]")).
1a10: 20 20 20 20 20 20 20 20 20 20 20 28 63 2d 65 78 (c-ex
1a20: 70 72 20 28 63 61 64 64 64 72 20 78 29 29 29 0a pr (cadddr x))).
1a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
1a40: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
1a50: 28 65 78 74 65 72 6e 2f 43 29 20 28 28 61 70 70 (extern/C) ((app
1a60: 6c 79 20 63 2d 65 78 74 65 72 6e 2f 43 20 28 63 ly c-extern/C (c
1a70: 64 72 20 78 29 29 20 73 74 29 29 0a 20 20 20 20 dr x)) st)).
1a80: 20 20 20 20 20 20 20 20 28 28 25 61 70 70 6c 79 ((%apply
1a90: 29 20 28 28 61 70 70 6c 79 20 63 2d 61 70 70 6c ) ((apply c-appl
1aa0: 79 20 28 63 64 72 20 78 29 29 20 73 74 29 29 0a y (cdr x)) st)).
1ab0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 25 64 ((%d
1ac0: 65 66 69 6e 65 29 20 28 28 61 70 70 6c 79 20 63 efine) ((apply c
1ad0: 70 70 2d 64 65 66 69 6e 65 20 28 63 64 72 20 78 pp-define (cdr x
1ae0: 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 )) st)).
1af0: 20 20 20 20 28 28 25 69 6e 63 6c 75 64 65 29 20 ((%include)
1b00: 28 28 61 70 70 6c 79 20 63 70 70 2d 69 6e 63 6c ((apply cpp-incl
1b10: 75 64 65 20 28 63 64 72 20 78 29 29 20 73 74 29 ude (cdr x)) st)
1b20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ). ((
1b30: 25 66 75 6e 29 20 28 28 61 70 70 6c 79 20 63 2d %fun) ((apply c-
1b40: 66 75 6e 20 28 63 64 72 20 78 29 29 20 73 74 29 fun (cdr x)) st)
1b50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ). ((
1b60: 25 63 6f 6e 64 29 0a 20 20 20 20 20 20 20 20 20 %cond).
1b70: 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 (let lp ((ls
1b80: 20 28 63 64 72 20 78 29 29 20 28 72 65 73 20 27 (cdr x)) (res '
1b90: 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ())).
1ba0: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6c (if (null? l
1bb0: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
1bc0: 20 20 20 20 20 20 28 28 61 70 70 6c 79 20 63 2d ((apply c-
1bd0: 69 66 20 28 72 65 76 65 72 73 65 20 72 65 73 29 if (reverse res)
1be0: 29 20 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 ) st).
1bf0: 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 (lp (cd
1c00: 72 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 r ls).
1c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
1c20: 6e 73 20 28 69 66 20 28 70 61 69 72 3f 20 28 63 ns (if (pair? (c
1c30: 64 64 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 ddar ls)).
1c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c50: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
1c60: 79 20 63 2d 62 65 67 69 6e 20 28 63 64 61 72 20 y c-begin (cdar
1c70: 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ls)).
1c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c90: 20 20 20 20 20 20 28 63 61 64 61 72 20 6c 73 29 (cadar ls)
1ca0: 29 0a 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 28 (
1cc0: 63 6f 6e 73 20 28 63 61 61 72 20 6c 73 29 20 72 cons (caar ls) r
1cd0: 65 73 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 es)))))).
1ce0: 20 20 20 20 20 28 28 25 70 72 6f 74 6f 74 79 70 ((%prototyp
1cf0: 65 29 20 28 28 61 70 70 6c 79 20 63 2d 70 72 6f e) ((apply c-pro
1d00: 74 6f 74 79 70 65 20 28 63 64 72 20 78 29 29 20 totype (cdr x))
1d10: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
1d20: 20 28 28 25 76 61 72 29 20 28 28 61 70 70 6c 79 ((%var) ((apply
1d30: 20 63 2d 76 61 72 20 28 63 64 72 20 78 29 29 20 c-var (cdr x))
1d40: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
1d50: 20 28 28 25 62 65 67 69 6e 29 20 28 28 61 70 70 ((%begin) ((app
1d60: 6c 79 20 63 2d 62 65 67 69 6e 20 28 63 64 72 20 ly c-begin (cdr
1d70: 78 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 x)) st)).
1d80: 20 20 20 20 20 28 28 25 61 74 74 72 69 62 75 74 ((%attribut
1d90: 65 29 20 28 28 61 70 70 6c 79 20 63 2d 61 74 74 e) ((apply c-att
1da0: 72 69 62 75 74 65 20 28 63 64 72 20 78 29 29 20 ribute (cdr x))
1db0: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
1dc0: 20 28 28 25 6c 69 6e 65 29 20 28 28 61 70 70 6c ((%line) ((appl
1dd0: 79 20 63 70 70 2d 6c 69 6e 65 20 28 63 64 72 20 y cpp-line (cdr
1de0: 78 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 x)) st)).
1df0: 20 20 20 20 20 28 28 25 70 72 61 67 6d 61 20 25 ((%pragma %
1e00: 65 72 72 6f 72 20 25 77 61 72 6e 69 6e 67 29 0a error %warning).
1e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 ((a
1e20: 70 70 6c 79 20 63 70 70 2d 67 65 6e 65 72 69 63 pply cpp-generic
1e30: 20 28 73 75 62 73 74 72 69 6e 67 2f 73 68 61 72 (substring/shar
1e40: 65 64 20 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 ed (symbol->stri
1e50: 6e 67 20 28 63 61 72 20 78 29 29 20 31 29 0a 20 ng (car x)) 1).
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e70: 20 20 20 20 28 63 64 72 20 78 29 29 20 73 74 29 (cdr x)) st)
1e80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ). ((
1e90: 25 69 66 20 25 69 66 64 65 66 20 25 69 66 6e 64 %if %ifdef %ifnd
1ea0: 65 66 20 25 65 6c 69 66 29 0a 20 20 20 20 20 20 ef %elif).
1eb0: 20 20 20 20 20 20 20 28 28 61 70 70 6c 79 20 63 ((apply c
1ec0: 70 70 2d 69 66 2f 61 75 78 20 28 73 75 62 73 74 pp-if/aux (subst
1ed0: 72 69 6e 67 2f 73 68 61 72 65 64 20 28 73 79 6d ring/shared (sym
1ee0: 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 28 63 61 72 bol->string (car
1ef0: 20 78 29 29 20 31 29 0a 20 20 20 20 20 20 20 20 x)) 1).
1f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 (cd
1f10: 72 20 78 29 29 20 73 74 29 29 0a 20 20 20 20 20 r x)) st)).
1f20: 20 20 20 20 20 20 20 28 28 25 65 6e 64 69 66 29 ((%endif)
1f30: 20 28 28 61 70 70 6c 79 20 63 70 70 2d 65 6e 64 ((apply cpp-end
1f40: 69 66 20 28 63 64 72 20 78 29 29 20 73 74 29 29 if (cdr x)) st))
1f50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 25 . ((%
1f60: 62 6c 6f 63 6b 29 20 28 28 61 70 70 6c 79 20 63 block) ((apply c
1f70: 2d 62 72 61 63 65 64 2d 62 6c 6f 63 6b 20 28 63 -braced-block (c
1f80: 64 72 20 78 29 29 20 73 74 29 29 0a 20 20 20 20 dr x)) st)).
1f90: 20 20 20 20 20 20 20 20 28 28 25 63 6f 6d 6d 65 ((%comme
1fa0: 6e 74 29 20 28 28 61 70 70 6c 79 20 63 2d 63 6f nt) ((apply c-co
1fb0: 6d 6d 65 6e 74 20 28 63 64 72 20 78 29 29 20 73 mment (cdr x)) s
1fc0: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
1fd0: 28 28 3a 29 20 28 28 61 70 70 6c 79 20 63 2d 6c ((:) ((apply c-l
1fe0: 61 62 65 6c 20 28 63 64 72 20 78 29 29 20 73 74 abel (cdr x)) st
1ff0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
2000: 28 25 63 61 73 74 29 20 28 28 61 70 70 6c 79 20 (%cast) ((apply
2010: 63 2d 63 61 73 74 20 28 63 64 72 20 78 29 29 20 c-cast (cdr x))
2020: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
2030: 20 28 28 2b 20 2d 20 26 20 2a 20 2f 20 25 20 21 ((+ - & * / % !
2040: 20 7e 20 5e 20 26 26 20 3c 20 3e 20 3c 3d 20 3e ~ ^ && < > <= >
2050: 3d 20 3d 3d 20 21 3d 20 3c 3c 20 3e 3e 0a 20 20 = == != << >>.
2060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d 20 =
2070: 2a 3d 20 2f 3d 20 25 3d 20 26 3d 20 5e 3d 20 3e *= /= %= &= ^= >
2080: 3e 3d 20 3c 3c 3d 29 20 3b 20 7c 5c 7c 7c 20 7c >= <<=) ; |\|| |
2090: 5c 7c 5c 7c 7c 20 7c 5c 7c 3d 7c 0a 20 20 20 20 \|\|| |\|=|.
20a0: 20 20 20 20 20 20 20 20 20 28 28 61 70 70 6c 79 ((apply
20b0: 20 63 2d 6f 70 20 78 29 20 73 74 29 29 0a 20 20 c-op x) st)).
20c0: 20 20 20 20 20 20 20 20 20 20 28 28 62 69 74 77 ((bitw
20d0: 69 73 65 2d 61 6e 64 20 62 69 74 2d 61 6e 64 29 ise-and bit-and)
20e0: 20 28 28 61 70 70 6c 79 20 63 2d 6f 70 20 27 26 ((apply c-op '&
20f0: 20 28 63 64 72 20 78 29 29 20 73 74 29 29 0a 20 (cdr x)) st)).
2100: 20 20 20 20 20 20 20 20 20 20 20 28 28 62 69 74 ((bit
2110: 77 69 73 65 2d 69 6f 72 20 62 69 74 2d 6f 72 29 wise-ior bit-or)
2120: 20 28 28 61 70 70 6c 79 20 63 2d 6f 70 20 22 7c ((apply c-op "|
2130: 22 20 28 63 64 72 20 78 29 29 20 73 74 29 29 0a " (cdr x)) st)).
2140: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 62 69 ((bi
2150: 74 77 69 73 65 2d 78 6f 72 20 62 69 74 2d 78 6f twise-xor bit-xo
2160: 72 29 20 28 28 61 70 70 6c 79 20 63 2d 6f 70 20 r) ((apply c-op
2170: 27 5e 20 28 63 64 72 20 78 29 29 20 73 74 29 29 '^ (cdr x)) st))
2180: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 62 . ((b
2190: 69 74 77 69 73 65 2d 6e 6f 74 20 62 69 74 2d 6e itwise-not bit-n
21a0: 6f 74 29 20 28 28 61 70 70 6c 79 20 63 2d 6f 70 ot) ((apply c-op
21b0: 20 27 7e 20 28 63 64 72 20 78 29 29 20 73 74 29 '~ (cdr x)) st)
21c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ). ((
21d0: 61 72 69 74 68 6d 65 74 69 63 2d 73 68 69 66 74 arithmetic-shift
21e0: 29 20 28 28 61 70 70 6c 79 20 63 2d 6f 70 20 27 ) ((apply c-op '
21f0: 3c 3c 20 28 63 64 72 20 78 29 29 20 73 74 29 29 << (cdr x)) st))
2200: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 62 . ((b
2210: 69 74 77 69 73 65 2d 69 6f 72 3d 20 62 69 74 2d itwise-ior= bit-
2220: 6f 72 3d 29 20 28 28 61 70 70 6c 79 20 63 2d 6f or=) ((apply c-o
2230: 70 20 22 7c 3d 22 20 28 63 64 72 20 78 29 29 20 p "|=" (cdr x))
2240: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
2250: 20 28 28 25 6f 72 29 20 28 28 61 70 70 6c 79 20 ((%or) ((apply
2260: 63 2d 6f 70 20 22 7c 7c 22 20 28 63 64 72 20 78 c-op "||" (cdr x
2270: 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 )) st)).
2280: 20 20 20 20 28 28 25 2e 20 25 66 69 65 6c 64 29 ((%. %field)
2290: 20 28 28 61 70 70 6c 79 20 63 2d 6f 70 20 22 2e ((apply c-op ".
22a0: 22 20 28 63 64 72 20 78 29 29 20 73 74 29 29 0a " (cdr x)) st)).
22b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 25 2d ((%-
22c0: 3e 29 20 28 28 61 70 70 6c 79 20 63 2d 6f 70 20 >) ((apply c-op
22d0: 22 2d 3e 22 20 28 63 64 72 20 78 29 29 20 73 74 "->" (cdr x)) st
22e0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
22f0: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
2300: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
2310: 20 20 20 20 20 20 28 28 65 71 3f 20 28 63 61 72 ((eq? (car
2320: 20 78 29 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d x) (string->sym
2330: 62 6f 6c 20 22 2e 22 29 29 0a 20 20 20 20 20 20 bol ".")).
2340: 20 20 20 20 20 20 20 20 20 28 28 61 70 70 6c 79 ((apply
2350: 20 63 2d 6f 70 20 22 2e 22 20 28 63 64 72 20 78 c-op "." (cdr x
2360: 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 )) st)).
2370: 20 20 20 20 20 20 28 28 65 71 3f 20 28 63 61 72 ((eq? (car
2380: 20 78 29 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d x) (string->sym
2390: 62 6f 6c 20 22 2d 3e 22 29 29 0a 20 20 20 20 20 bol "->")).
23a0: 20 20 20 20 20 20 20 20 20 20 28 28 61 70 70 6c ((appl
23b0: 79 20 63 2d 6f 70 20 22 2d 3e 22 20 28 63 64 72 y c-op "->" (cdr
23c0: 20 78 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 x)) st)).
23d0: 20 20 20 20 20 20 20 20 28 28 65 71 3f 20 28 63 ((eq? (c
23e0: 61 72 20 78 29 20 28 73 74 72 69 6e 67 2d 3e 73 ar x) (string->s
23f0: 79 6d 62 6f 6c 20 22 2b 2b 22 29 29 0a 20 20 20 ymbol "++")).
2400: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 70 ((ap
2410: 70 6c 79 20 63 2d 6f 70 20 22 2b 2b 22 20 28 63 ply c-op "++" (c
2420: 64 72 20 78 29 29 20 73 74 29 29 0a 20 20 20 20 dr x)) st)).
2430: 20 20 20 20 20 20 20 20 20 20 28 28 65 71 3f 20 ((eq?
2440: 28 63 61 72 20 78 29 20 28 73 74 72 69 6e 67 2d (car x) (string-
2450: 3e 73 79 6d 62 6f 6c 20 22 2d 2d 22 29 29 0a 20 >symbol "--")).
2460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2470: 61 70 70 6c 79 20 63 2d 6f 70 20 22 2d 2d 22 20 apply c-op "--"
2480: 28 63 64 72 20 78 29 29 20 73 74 29 29 0a 20 20 (cdr x)) st)).
2490: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 65 71 ((eq
24a0: 3f 20 28 63 61 72 20 78 29 20 28 73 74 72 69 6e ? (car x) (strin
24b0: 67 2d 3e 73 79 6d 62 6f 6c 20 22 2b 3d 22 29 29 g->symbol "+="))
24c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
24d0: 28 28 61 70 70 6c 79 20 63 2d 6f 70 20 22 2b 3d ((apply c-op "+=
24e0: 22 20 28 63 64 72 20 78 29 29 20 73 74 29 29 0a " (cdr x)) st)).
24f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
2500: 65 71 3f 20 28 63 61 72 20 78 29 20 28 73 74 72 eq? (car x) (str
2510: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 22 2d 3d 22 ing->symbol "-="
2520: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2530: 20 20 28 28 61 70 70 6c 79 20 63 2d 6f 70 20 22 ((apply c-op "
2540: 2d 3d 22 20 28 63 64 72 20 78 29 29 20 73 74 29 -=" (cdr x)) st)
2550: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2560: 28 65 6c 73 65 20 28 28 63 2d 61 70 70 6c 79 20 (else ((c-apply
2570: 78 29 20 73 74 29 29 29 29 29 29 0a 20 20 20 20 x) st)))))).
2580: 20 20 20 20 20 28 28 76 65 63 74 6f 72 3f 20 78 ((vector? x
2590: 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 63 2d ). ((c-
25a0: 77 72 61 70 2d 73 74 6d 74 0a 20 20 20 20 20 20 wrap-stmt.
25b0: 20 20 20 20 20 20 28 66 6d 74 2d 74 72 79 2d 66 (fmt-try-f
25c0: 69 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 it.
25d0: 28 66 6d 74 2d 6c 65 74 20 27 6e 6f 2d 77 72 61 (fmt-let 'no-wra
25e0: 70 3f 20 23 74 0a 20 20 20 20 20 20 20 20 20 20 p? #t.
25f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 74 (cat
2600: 20 22 7b 22 20 28 66 6d 74 2d 6a 6f 69 6e 20 63 "{" (fmt-join c
2610: 2d 65 78 70 72 20 28 76 65 63 74 6f 72 2d 3e 6c -expr (vector->l
2620: 69 73 74 20 78 29 20 22 2c 20 22 29 20 22 7d 22 ist x) ", ") "}"
2630: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2640: 28 6c 61 6d 62 64 61 20 28 73 74 29 0a 20 20 20 (lambda (st).
2650: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
2660: 2a 20 28 28 63 6f 6c 20 28 66 6d 74 2d 63 6f 6c * ((col (fmt-col
2670: 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 st)).
2680: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 70 (sep
2690: 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 (string-append
26a0: 22 2c 22 20 28 6d 61 6b 65 2d 6e 6c 2d 73 70 61 "," (make-nl-spa
26b0: 63 65 20 63 6f 6c 29 29 29 29 0a 20 20 20 20 20 ce col)))).
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 61 ((ca
26d0: 74 20 22 7b 22 20 28 66 6d 74 2d 6a 6f 69 6e 20 t "{" (fmt-join
26e0: 63 2d 65 78 70 72 20 28 76 65 63 74 6f 72 2d 3e c-expr (vector->
26f0: 6c 69 73 74 20 78 29 20 73 65 70 29 0a 20 20 20 list x) sep).
2700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2710: 20 20 20 20 22 7d 22 20 6e 6c 29 0a 20 20 20 20 "}" nl).
2720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
2730: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
2740: 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 28 st)). (
2750: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 28 else. (
2760: 28 63 2d 6c 69 74 65 72 61 6c 20 78 29 20 73 74 (c-literal x) st
2770: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
2780: 28 63 2d 61 70 70 6c 79 20 6c 73 29 0a 20 20 28 (c-apply ls). (
2790: 63 2d 77 72 61 70 2d 73 74 6d 74 0a 20 20 20 28 c-wrap-stmt. (
27a0: 63 2d 77 69 74 68 2d 6f 70 0a 20 20 20 20 27 70 c-with-op. 'p
27b0: 61 72 65 6e 0a 20 20 20 20 28 63 61 74 20 28 63 aren. (cat (c
27c0: 2d 65 78 70 72 20 28 63 61 72 20 6c 73 29 29 0a -expr (car ls)).
27d0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
27e0: 66 6c 61 74 20 28 66 6d 74 2d 6c 65 74 20 27 6e flat (fmt-let 'n
27f0: 6f 2d 77 72 61 70 3f 20 23 74 20 28 66 6d 74 2d o-wrap? #t (fmt-
2800: 6a 6f 69 6e 20 63 2d 65 78 70 72 20 28 63 64 72 join c-expr (cdr
2810: 20 6c 73 29 20 22 2c 20 22 29 29 29 29 0a 20 20 ls) ", ")))).
2820: 20 20 20 20 20 20 20 20 20 28 66 6d 74 2d 69 66 (fmt-if
2830: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 6d 74 . fmt
2840: 2d 6e 6f 2d 77 72 61 70 3f 0a 20 20 20 20 20 20 -no-wrap?.
2850: 20 20 20 20 20 20 28 63 2d 70 61 72 65 6e 20 66 (c-paren f
2860: 6c 61 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 lat).
2870: 20 28 63 2d 70 61 72 65 6e 0a 20 20 20 20 20 20 (c-paren.
2880: 20 20 20 20 20 20 20 28 66 6d 74 2d 74 72 79 2d (fmt-try-
2890: 66 69 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 fit.
28a0: 20 20 66 6c 61 74 0a 20 20 20 20 20 20 20 20 20 flat.
28b0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 (lambda (st
28c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
28d0: 20 20 28 6c 65 74 2a 20 28 28 63 6f 6c 20 28 66 (let* ((col (f
28e0: 6d 74 2d 63 6f 6c 20 73 74 29 29 0a 20 20 20 20 mt-col st)).
28f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2900: 20 20 20 28 73 65 70 20 28 73 74 72 69 6e 67 2d (sep (string-
2910: 61 70 70 65 6e 64 20 22 2c 22 20 28 6d 61 6b 65 append "," (make
2920: 2d 6e 6c 2d 73 70 61 63 65 20 63 6f 6c 29 29 29 -nl-space col)))
2930: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2940: 20 20 20 20 28 28 66 6d 74 2d 6a 6f 69 6e 20 63 ((fmt-join c
2950: 2d 65 78 70 72 20 28 63 64 72 20 6c 73 29 20 73 -expr (cdr ls) s
2960: 65 70 29 20 73 74 29 29 29 29 29 29 29 29 29 29 ep) st))))))))))
2970: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 65 78 )..(define (c-ex
2980: 70 72 20 78 29 0a 20 20 28 6c 61 6d 62 64 61 20 pr x). (lambda
2990: 28 73 74 29 20 28 28 28 6f 72 20 28 66 6d 74 2d (st) (((or (fmt-
29a0: 67 65 6e 20 73 74 29 20 63 2d 65 78 70 72 2f 73 gen st) c-expr/s
29b0: 65 78 70 29 20 78 29 20 73 74 29 29 29 0a 0a 3b exp) x) st)))..;
29c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
29d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
29e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
29f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2a00: 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 63 6f 6d 6d 65 ;;;;;;;.;; comme
2a10: 6e 74 73 2c 20 77 69 74 68 20 45 6d 61 63 73 2d nts, with Emacs-
2a20: 66 72 69 65 6e 64 6c 79 20 65 73 63 61 70 69 6e friendly escapin
2a30: 67 20 6f 66 20 6e 65 73 74 65 64 20 63 6f 6d 6d g of nested comm
2a40: 65 6e 74 73 0a 0a 28 64 65 66 69 6e 65 20 28 6d ents..(define (m
2a50: 61 6b 65 2d 63 6f 6d 6d 65 6e 74 2d 77 72 69 74 ake-comment-writ
2a60: 65 72 20 73 74 29 0a 20 20 28 6c 65 74 20 28 28 er st). (let ((
2a70: 6f 75 74 70 75 74 20 28 66 6d 74 2d 72 65 66 20 output (fmt-ref
2a80: 73 74 20 27 77 72 69 74 65 72 29 29 29 0a 20 20 st 'writer))).
2a90: 20 20 28 6c 61 6d 62 64 61 20 28 73 74 72 20 73 (lambda (str s
2aa0: 74 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 t). (let ((
2ab0: 6c 69 6d 20 28 2d 20 28 73 74 72 69 6e 67 2d 6c lim (- (string-l
2ac0: 65 6e 67 74 68 20 73 74 72 29 20 31 29 29 29 0a ength str) 1))).
2ad0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 20 (let lp
2ae0: 28 28 69 20 30 29 20 28 73 74 20 73 74 29 29 0a ((i 0) (st st)).
2af0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
2b00: 28 6a 20 28 73 74 72 69 6e 67 2d 69 6e 64 65 78 (j (string-index
2b10: 20 73 74 72 20 23 5c 2f 20 69 29 29 29 0a 20 20 str #\/ i))).
2b20: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 6a 0a (if j.
2b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b40: 28 6c 65 74 20 28 28 73 74 20 28 69 66 20 28 61 (let ((st (if (a
2b50: 6e 64 20 28 3e 20 6a 20 30 29 0a 20 20 20 20 20 nd (> j 0).
2b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
2b80: 71 76 3f 20 23 5c 2a 20 28 73 74 72 69 6e 67 2d qv? #\* (string-
2b90: 72 65 66 20 73 74 72 20 28 2d 20 6a 20 31 29 29 ref str (- j 1))
2ba0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bc0: 20 28 6f 75 74 70 75 74 0a 20 20 20 20 20 20 20 (output.
2bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2be0: 20 20 20 20 20 20 20 20 22 5c 5c 2f 22 0a 20 20 "\\/".
2bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 75 (ou
2c10: 74 70 75 74 20 28 73 75 62 73 74 72 69 6e 67 2f tput (substring/
2c20: 73 68 61 72 65 64 20 73 74 72 20 69 20 6a 29 20 shared str i j)
2c30: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
2c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c50: 20 20 20 28 6f 75 74 70 75 74 20 28 73 75 62 73 (output (subs
2c60: 74 72 69 6e 67 2f 73 68 61 72 65 64 20 73 74 72 tring/shared str
2c70: 20 69 20 28 2b 20 6a 20 31 29 29 20 73 74 29 29 i (+ j 1)) st))
2c80: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2c90: 20 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 31 29 (lp (+ j 1)
2ca0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2cb0: 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
2cc0: 28 3c 20 6a 20 6c 69 6d 29 20 28 65 71 76 3f 20 (< j lim) (eqv?
2cd0: 23 5c 2a 20 28 73 74 72 69 6e 67 2d 72 65 66 20 #\* (string-ref
2ce0: 73 74 72 20 28 2b 20 6a 20 31 29 29 29 29 0a 20 str (+ j 1)))).
2cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d00: 20 20 20 20 20 20 20 20 20 28 6f 75 74 70 75 74 (output
2d10: 20 22 5c 5c 22 20 73 74 29 0a 20 20 20 20 20 20 "\\" st).
2d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d30: 20 20 20 20 73 74 29 29 29 0a 20 20 20 20 20 20 st))).
2d40: 20 20 20 20 20 20 20 20 20 20 28 6f 75 74 70 75 (outpu
2d50: 74 20 28 73 75 62 73 74 72 69 6e 67 2f 73 68 61 t (substring/sha
2d60: 72 65 64 20 73 74 72 20 69 29 20 73 74 29 29 29 red str i) st)))
2d70: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
2d80: 63 2d 63 6f 6d 6d 65 6e 74 20 2e 20 61 72 67 73 c-comment . args
2d90: 29 0a 20 20 28 6c 61 6d 62 64 61 20 28 73 74 29 ). (lambda (st)
2da0: 0a 20 20 20 20 28 28 63 61 74 20 22 2f 2a 22 20 . ((cat "/*"
2db0: 28 66 6d 74 2d 6c 65 74 20 27 77 72 69 74 65 72 (fmt-let 'writer
2dc0: 20 28 6d 61 6b 65 2d 63 6f 6d 6d 65 6e 74 2d 77 (make-comment-w
2dd0: 72 69 74 65 72 20 73 74 29 0a 20 20 20 20 20 20 riter st).
2de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2df0: 20 20 28 61 70 70 6c 79 2d 63 61 74 20 61 72 67 (apply-cat arg
2e00: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 22 2a s)). "*
2e10: 2f 22 29 0a 20 20 20 20 20 73 74 29 29 29 0a 0a /"). st)))..
2e20: 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 62 6c (define (make-bl
2e30: 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 77 72 69 74 ock-comment-writ
2e40: 65 72 20 73 74 29 0a 20 20 28 6c 65 74 20 28 28 er st). (let ((
2e50: 6f 75 74 70 75 74 20 28 6d 61 6b 65 2d 63 6f 6d output (make-com
2e60: 6d 65 6e 74 2d 77 72 69 74 65 72 20 73 74 29 29 ment-writer st))
2e70: 0a 20 20 20 20 20 20 20 20 28 69 6e 64 65 6e 74 . (indent
2e80: 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 (string-append
2e90: 28 6d 61 6b 65 2d 6e 6c 2d 73 70 61 63 65 20 28 (make-nl-space (
2ea0: 2b 20 28 66 6d 74 2d 63 6f 6c 20 73 74 29 20 31 + (fmt-col st) 1
2eb0: 29 29 20 22 2a 20 22 29 29 29 0a 20 20 20 20 28 )) "* "))). (
2ec0: 6c 61 6d 62 64 61 20 28 73 74 72 20 73 74 29 0a lambda (str st).
2ed0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 69 6d (let ((lim
2ee0: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
2ef0: 73 74 72 29 29 29 0a 20 20 20 20 20 20 20 20 28 str))). (
2f00: 6c 65 74 20 6c 70 20 28 28 69 20 30 29 20 28 73 let lp ((i 0) (s
2f10: 74 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 t st)).
2f20: 20 28 6c 65 74 20 28 28 6a 20 28 73 74 72 69 6e (let ((j (strin
2f30: 67 2d 69 6e 64 65 78 20 73 74 72 20 23 5c 6e 65 g-index str #\ne
2f40: 77 6c 69 6e 65 20 69 29 29 29 0a 20 20 20 20 20 wline i))).
2f50: 20 20 20 20 20 20 20 28 69 66 20 6a 0a 20 20 20 (if j.
2f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
2f70: 20 28 2b 20 6a 20 31 29 0a 20 20 20 20 20 20 20 (+ j 1).
2f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 75 (ou
2f90: 74 70 75 74 20 69 6e 64 65 6e 74 20 28 6f 75 74 tput indent (out
2fa0: 70 75 74 20 28 73 75 62 73 74 72 69 6e 67 2f 73 put (substring/s
2fb0: 68 61 72 65 64 20 73 74 72 20 69 20 6a 29 20 73 hared str i j) s
2fc0: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
2fd0: 20 20 20 20 20 28 6f 75 74 70 75 74 20 28 73 75 (output (su
2fe0: 62 73 74 72 69 6e 67 2f 73 68 61 72 65 64 20 73 bstring/shared s
2ff0: 74 72 20 69 29 20 73 74 29 29 29 29 29 29 29 29 tr i) st))))))))
3000: 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 62 6c 6f ..(define (c-blo
3010: 63 6b 2d 63 6f 6d 6d 65 6e 74 20 2e 20 61 72 67 ck-comment . arg
3020: 73 29 0a 20 20 28 6c 61 6d 62 64 61 20 28 73 74 s). (lambda (st
3030: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 63 6f 6c ). (let ((col
3040: 20 28 66 6d 74 2d 63 6f 6c 20 73 74 29 29 0a 20 (fmt-col st)).
3050: 20 20 20 20 20 20 20 20 20 28 72 6f 77 20 28 66 (row (f
3060: 6d 74 2d 72 6f 77 20 73 74 29 29 0a 20 20 20 20 mt-row st)).
3070: 20 20 20 20 20 20 28 69 6e 64 65 6e 74 20 28 63 (indent (c
3080: 2d 63 75 72 72 65 6e 74 2d 69 6e 64 65 6e 74 2d -current-indent-
3090: 73 74 72 69 6e 67 20 73 74 29 29 29 0a 20 20 20 string st))).
30a0: 20 20 20 28 28 63 61 74 20 22 2f 2a 20 22 0a 20 ((cat "/* ".
30b0: 20 20 20 20 20 20 20 20 20 20 20 28 66 6d 74 2d (fmt-
30c0: 6c 65 74 20 27 77 72 69 74 65 72 20 28 6d 61 6b let 'writer (mak
30d0: 65 2d 62 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d e-block-comment-
30e0: 77 72 69 74 65 72 20 73 74 29 20 28 61 70 70 6c writer st) (appl
30f0: 79 2d 63 61 74 20 61 72 67 73 29 29 0a 20 20 20 y-cat args)).
3100: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
3110: 20 28 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 (st).
3120: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
3130: 20 20 20 20 20 20 20 20 20 20 28 28 3d 20 72 6f ((= ro
3140: 77 20 28 66 6d 74 2d 72 6f 77 20 73 74 29 29 20 w (fmt-row st))
3150: 28 28 64 73 70 20 22 20 2a 2f 22 29 20 73 74 29 ((dsp " */") st)
3160: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3170: 20 20 3b 3b 28 28 3d 20 28 2b 20 33 20 63 6f 6c ;;((= (+ 3 col
3180: 29 20 28 66 6d 74 2d 63 6f 6c 20 73 74 29 29 20 ) (fmt-col st))
3190: 28 28 64 73 70 20 22 2a 2f 22 29 20 73 74 29 29 ((dsp "*/") st))
31a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
31b0: 20 28 65 6c 73 65 20 28 28 63 61 74 20 66 6c 20 (else ((cat fl
31c0: 69 6e 64 65 6e 74 20 22 20 2a 2f 22 29 20 73 74 indent " */") st
31d0: 29 29 29 29 29 0a 20 20 20 20 20 20 20 73 74 29 ))))). st)
31e0: 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b )))..;;;;;;;;;;;
31f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
3200: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
3210: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
3220: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b ;;;;;;;;;;;;;.;;
3230: 20 70 72 65 70 72 6f 63 65 73 73 6f 72 0a 0a 28 preprocessor..(
3240: 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 63 70 70 define (make-cpp
3250: 2d 77 72 69 74 65 72 20 73 74 29 0a 20 20 28 6c -writer st). (l
3260: 65 74 20 28 28 6f 75 74 70 75 74 20 28 66 6d 74 et ((output (fmt
3270: 2d 72 65 66 20 73 74 20 27 77 72 69 74 65 72 29 -ref st 'writer)
3280: 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 )). (lambda (
3290: 73 74 72 20 73 74 29 0a 20 20 20 20 20 20 28 6c str st). (l
32a0: 65 74 20 6c 70 20 28 28 69 20 30 29 20 28 73 74 et lp ((i 0) (st
32b0: 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 28 6c st)). (l
32c0: 65 74 20 28 28 6a 20 28 73 74 72 69 6e 67 2d 69 et ((j (string-i
32d0: 6e 64 65 78 20 73 74 72 20 23 5c 6e 65 77 6c 69 ndex str #\newli
32e0: 6e 65 20 69 29 29 29 0a 20 20 20 20 20 20 20 20 ne i))).
32f0: 20 20 28 69 66 20 6a 0a 20 20 20 20 20 20 20 20 (if j.
3300: 20 20 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 31 (lp (+ j 1
3310: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3320: 20 20 20 20 28 6f 75 74 70 75 74 0a 20 20 20 20 (output.
3330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e n
3340: 6c 2d 73 74 72 0a 20 20 20 20 20 20 20 20 20 20 l-str.
3350: 20 20 20 20 20 20 20 20 20 28 6f 75 74 70 75 74 (output
3360: 20 22 20 5c 5c 22 20 28 6f 75 74 70 75 74 20 28 " \\" (output (
3370: 73 75 62 73 74 72 69 6e 67 2f 73 68 61 72 65 64 substring/shared
3380: 20 73 74 72 20 69 20 6a 29 20 73 74 29 29 29 29 str i j) st))))
3390: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
33a0: 6f 75 74 70 75 74 20 28 73 75 62 73 74 72 69 6e output (substrin
33b0: 67 2f 73 68 61 72 65 64 20 73 74 72 20 69 29 20 g/shared str i)
33c0: 73 74 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 st)))))))..(defi
33d0: 6e 65 20 28 63 70 70 2d 69 6e 63 6c 75 64 65 20 ne (cpp-include
33e0: 66 69 6c 65 29 0a 20 20 28 69 66 20 28 73 74 72 file). (if (str
33f0: 69 6e 67 3f 20 66 69 6c 65 29 0a 20 20 20 20 20 ing? file).
3400: 20 28 63 61 74 20 66 6c 20 22 23 69 6e 63 6c 75 (cat fl "#inclu
3410: 64 65 20 22 20 28 77 72 74 20 66 69 6c 65 29 20 de " (wrt file)
3420: 66 6c 29 0a 20 20 20 20 20 20 28 63 61 74 20 66 fl). (cat f
3430: 6c 20 22 23 69 6e 63 6c 75 64 65 20 3c 22 20 66 l "#include <" f
3440: 69 6c 65 20 22 3e 22 20 66 6c 29 29 29 0a 0a 28 ile ">" fl)))..(
3450: 64 65 66 69 6e 65 20 28 6c 69 73 74 2d 64 6f 74 define (list-dot
3460: 20 78 29 0a 20 20 28 63 6f 6e 64 20 28 28 70 61 x). (cond ((pa
3470: 69 72 3f 20 78 29 20 28 6c 69 73 74 2d 64 6f 74 ir? x) (list-dot
3480: 20 28 63 64 72 20 78 29 29 29 0a 20 20 20 20 20 (cdr x))).
3490: 20 20 20 28 28 6e 75 6c 6c 3f 20 78 29 20 23 66 ((null? x) #f
34a0: 29 0a 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 ). (else
34b0: 78 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 x)))..(define (r
34c0: 65 70 6c 61 63 65 2d 74 72 65 65 20 66 72 6f 6d eplace-tree from
34d0: 20 74 6f 20 78 29 0a 20 20 28 6c 65 74 20 72 65 to x). (let re
34e0: 70 6c 61 63 65 20 28 28 78 20 78 29 29 0a 20 20 place ((x x)).
34f0: 20 20 28 63 6f 6e 64 20 28 28 65 71 3f 20 78 20 (cond ((eq? x
3500: 66 72 6f 6d 29 20 74 6f 29 0a 20 20 20 20 20 20 from) to).
3510: 20 20 20 20 28 28 70 61 69 72 3f 20 78 29 20 28 ((pair? x) (
3520: 63 6f 6e 73 20 28 72 65 70 6c 61 63 65 20 28 63 cons (replace (c
3530: 61 72 20 78 29 29 20 28 72 65 70 6c 61 63 65 20 ar x)) (replace
3540: 28 63 64 72 20 78 29 29 29 29 0a 20 20 20 20 20 (cdr x)))).
3550: 20 20 20 20 20 28 65 6c 73 65 20 78 29 29 29 29 (else x))))
3560: 0a 0a 28 64 65 66 69 6e 65 20 28 63 70 70 2d 64 ..(define (cpp-d
3570: 65 66 69 6e 65 20 78 20 2e 20 62 6f 64 79 29 0a efine x . body).
3580: 20 20 28 64 65 66 69 6e 65 20 28 6e 61 6d 65 2d (define (name-
3590: 6f 66 20 78 29 20 28 63 2d 65 78 70 72 20 28 69 of x) (c-expr (i
35a0: 66 20 28 70 61 69 72 3f 20 78 29 20 28 63 61 64 f (pair? x) (cad
35b0: 72 20 78 29 20 78 29 29 29 0a 20 20 28 6c 61 6d r x) x))). (lam
35c0: 62 64 61 20 28 73 74 29 0a 20 20 20 20 28 6c 65 bda (st). (le
35d0: 74 2a 20 28 28 62 6f 64 79 20 28 63 6f 6e 64 0a t* ((body (cond.
35e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
35f0: 20 20 20 28 28 61 6e 64 20 28 70 61 69 72 3f 20 ((and (pair?
3600: 78 29 20 28 6c 69 73 74 2d 64 6f 74 20 78 29 29 x) (list-dot x))
3610: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3620: 20 20 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 20 => (lambda
3630: 28 64 6f 74 29 0a 20 20 20 20 20 20 20 20 20 20 (dot).
3640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3650: 69 66 20 28 65 71 3f 20 64 6f 74 20 27 2e 2e 2e if (eq? dot '...
3660: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 62 b
3680: 6f 64 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 ody.
3690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
36a0: 20 28 72 65 70 6c 61 63 65 2d 74 72 65 65 20 64 (replace-tree d
36b0: 6f 74 20 27 5f 5f 56 41 5f 41 52 47 53 5f 5f 20 ot '__VA_ARGS__
36c0: 62 6f 64 79 29 29 29 29 0a 20 20 20 20 20 20 20 body)))).
36d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
36e0: 65 20 62 6f 64 79 29 29 29 0a 20 20 20 20 20 20 e body))).
36f0: 20 20 20 20 20 28 74 61 69 6c 0a 20 20 20 20 20 (tail.
3700: 20 20 20 20 20 20 20 28 69 66 20 28 70 61 69 72 (if (pair
3710: 3f 20 62 6f 64 79 29 0a 20 20 20 20 20 20 20 20 ? body).
3720: 20 20 20 20 20 20 20 20 28 63 61 74 20 22 20 22 (cat " "
3730: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3740: 20 20 20 20 20 20 28 66 6d 74 2d 6c 65 74 20 27 (fmt-let '
3750: 77 72 69 74 65 72 20 28 6d 61 6b 65 2d 63 70 70 writer (make-cpp
3760: 2d 77 72 69 74 65 72 20 73 74 29 0a 20 20 20 20 -writer st).
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 28 66 6d 74 2d 6c (fmt-l
3790: 65 74 20 27 69 6e 2d 6d 61 63 72 6f 3f 20 28 70 et 'in-macro? (p
37a0: 61 69 72 3f 20 78 29 0a 20 20 20 20 20 20 20 20 air? x).
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 20 20 20 20 20 20 20 20 28 (
37d0: 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 28 70 61 (if (or (not (pa
37e0: 69 72 3f 20 78 29 29 0a 20 20 20 20 20 20 20 20 ir? x)).
37f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3810: 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 6e 75 (and (nu
3820: 6c 6c 3f 20 28 63 64 72 20 62 6f 64 79 29 29 0a ll? (cdr body)).
3830: 20 20 20 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 20 20 20
3850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3860: 20 20 20 20 20 28 63 2d 6c 69 74 65 72 61 6c 3f (c-literal?
3870: 20 28 63 61 72 20 62 6f 64 79 29 29 29 29 0a 20 (car body)))).
3880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38a0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
38b0: 64 61 20 28 78 29 20 78 29 0a 20 20 20 20 20 20 da (x) x).
38c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38e0: 20 20 20 20 20 20 63 2d 70 61 72 65 6e 29 0a 20 c-paren).
38f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3910: 20 20 20 20 20 20 20 28 63 2d 69 6e 2d 65 78 70 (c-in-exp
3920: 72 20 28 61 70 70 6c 79 20 63 2d 62 65 67 69 6e r (apply c-begin
3930: 20 62 6f 64 79 29 29 29 29 29 29 0a 20 20 20 20 body)))))).
3940: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
3950: 62 64 61 20 28 78 29 20 78 29 29 29 29 0a 20 20 bda (x) x)))).
3960: 20 20 20 20 28 28 63 2d 69 6e 2d 65 78 70 72 0a ((c-in-expr.
3970: 20 20 20 20 20 20 20 20 28 69 66 20 28 70 61 69 (if (pai
3980: 72 3f 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 r? x).
3990: 20 20 28 63 61 74 20 66 6c 20 22 23 64 65 66 69 (cat fl "#defi
39a0: 6e 65 20 22 20 28 6e 61 6d 65 2d 6f 66 20 28 63 ne " (name-of (c
39b0: 61 72 20 78 29 29 0a 20 20 20 20 20 20 20 20 20 ar x)).
39c0: 20 20 20 20 20 20 20 20 28 63 2d 70 61 72 65 6e (c-paren
39d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
39e0: 20 20 20 28 66 6d 74 2d 6a 6f 69 6e 2f 64 6f 74 (fmt-join/dot
39f0: 20 6e 61 6d 65 2d 6f 66 0a 20 20 20 20 20 20 20 name-of.
3a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a10: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
3a20: 20 28 64 6f 74 29 20 28 64 73 70 20 22 2e 2e 2e (dot) (dsp "...
3a30: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
3a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a50: 20 20 20 20 28 63 64 72 20 78 29 0a 20 20 20 20 (cdr x).
3a60: 20 20 20 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 22 2c 20 22 ", "
3a80: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3a90: 20 20 20 20 74 61 69 6c 20 66 6c 29 0a 20 20 20 tail fl).
3aa0: 20 20 20 20 20 20 20 20 20 28 63 61 74 20 66 6c (cat fl
3ab0: 20 22 23 64 65 66 69 6e 65 20 22 20 28 63 2d 65 "#define " (c-e
3ac0: 78 70 72 20 78 29 20 74 61 69 6c 20 66 6c 29 29 xpr x) tail fl))
3ad0: 29 0a 20 20 20 20 20 20 20 73 74 29 29 29 29 0a ). st)))).
3ae0: 0a 28 64 65 66 69 6e 65 20 28 63 70 70 2d 65 78 .(define (cpp-ex
3af0: 70 72 20 78 29 0a 20 20 28 69 66 20 28 6f 72 20 pr x). (if (or
3b00: 28 73 79 6d 62 6f 6c 3f 20 78 29 20 28 73 74 72 (symbol? x) (str
3b10: 69 6e 67 3f 20 78 29 29 20 28 64 73 70 20 78 29 ing? x)) (dsp x)
3b20: 20 28 63 2d 65 78 70 72 20 78 29 29 29 0a 0a 28 (c-expr x)))..(
3b30: 64 65 66 69 6e 65 20 28 63 70 70 2d 69 66 2f 61 define (cpp-if/a
3b40: 75 78 20 6e 61 6d 65 20 63 68 65 63 6b 20 2e 20 ux name check .
3b50: 6f 29 0a 20 20 28 6c 65 74 2a 20 28 28 70 61 73 o). (let* ((pas
3b60: 73 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 s (and (pair? o)
3b70: 20 28 63 61 72 20 6f 29 29 29 0a 20 20 20 20 20 (car o))).
3b80: 20 20 20 20 28 63 6f 6d 6d 65 6e 74 20 28 69 66 (comment (if
3b90: 20 28 6d 65 6d 62 65 72 20 6e 61 6d 65 20 27 28 (member name '(
3ba0: 22 69 66 64 65 66 22 20 22 69 66 6e 64 65 66 22 "ifdef" "ifndef"
3bb0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3bc0: 20 20 20 20 20 20 20 20 20 28 63 61 74 20 22 20 (cat "
3bd0: 20 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
3be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
3bf0: 2d 63 6f 6d 6d 65 6e 74 0a 20 20 20 20 20 20 20 -comment.
3c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c10: 20 20 20 20 20 22 20 22 20 28 69 66 20 28 65 71 " " (if (eq
3c20: 75 61 6c 3f 20 6e 61 6d 65 20 22 69 66 6e 64 65 ual? name "ifnde
3c30: 66 22 29 20 22 21 20 22 20 22 22 29 0a 20 20 20 f") "! " "").
3c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c50: 20 20 20 20 20 20 20 20 20 63 68 65 63 6b 20 22 check "
3c60: 20 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ")).
3c70: 20 20 20 20 20 20 20 20 20 20 20 22 22 29 29 0a "")).
3c80: 20 20 20 20 20 20 20 20 20 28 65 6e 64 69 66 20 (endif
3c90: 28 69 66 20 70 61 73 73 20 28 63 61 74 20 66 6c (if pass (cat fl
3ca0: 20 22 23 65 6e 64 69 66 22 20 63 6f 6d 6d 65 6e "#endif" commen
3cb0: 74 29 20 22 22 29 29 0a 20 20 20 20 20 20 20 20 t) "")).
3cc0: 20 28 74 61 69 6c 20 28 63 6f 6e 64 0a 20 20 20 (tail (cond.
3cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 ((a
3ce0: 6e 64 20 28 70 61 69 72 3f 20 6f 29 20 28 70 61 nd (pair? o) (pa
3cf0: 69 72 3f 20 28 63 64 72 20 6f 29 29 29 0a 20 20 ir? (cdr o))).
3d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3d10: 69 66 20 28 70 61 69 72 3f 20 28 63 64 64 72 20 if (pair? (cddr
3d20: 6f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 o)).
3d30: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 (apply
3d40: 63 70 70 2d 65 6c 69 66 20 28 63 64 72 20 6f 29 cpp-elif (cdr o)
3d50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3d60: 20 20 20 20 20 20 20 28 63 61 74 20 28 63 70 70 (cat (cpp
3d70: 2d 65 6c 73 65 29 20 28 63 61 64 72 20 6f 29 20 -else) (cadr o)
3d80: 65 6e 64 69 66 29 29 29 0a 20 20 20 20 20 20 20 endif))).
3d90: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 65 (else e
3da0: 6e 64 69 66 29 29 29 29 0a 20 20 20 20 28 6c 61 ndif)))). (la
3db0: 6d 62 64 61 20 28 73 74 29 0a 20 20 20 20 20 20 mbda (st).
3dc0: 28 6c 65 74 20 28 28 69 6e 64 65 6e 74 20 28 63 (let ((indent (c
3dd0: 2d 63 75 72 72 65 6e 74 2d 69 6e 64 65 6e 74 2d -current-indent-
3de0: 73 74 72 69 6e 67 20 73 74 29 29 29 0a 20 20 20 string st))).
3df0: 20 20 20 20 20 28 28 63 61 74 20 66 6c 20 22 23 ((cat fl "#
3e00: 22 20 6e 61 6d 65 20 22 20 22 20 28 63 70 70 2d " name " " (cpp-
3e10: 65 78 70 72 20 63 68 65 63 6b 29 20 66 6c 0a 20 expr check) fl.
3e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
3e30: 20 70 61 73 73 20 28 63 61 74 20 69 6e 64 65 6e pass (cat inden
3e40: 74 20 70 61 73 73 29 20 22 22 29 20 66 6c 0a 20 t pass) "") fl.
3e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 61 69 tai
3e60: 6c 20 66 6c 29 0a 20 20 20 20 20 20 20 20 20 73 l fl). s
3e70: 74 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 t)))))..(define
3e80: 28 63 70 70 2d 69 66 20 63 68 65 63 6b 20 2e 20 (cpp-if check .
3e90: 6f 29 0a 20 20 28 61 70 70 6c 79 20 63 70 70 2d o). (apply cpp-
3ea0: 69 66 2f 61 75 78 20 22 69 66 22 20 63 68 65 63 if/aux "if" chec
3eb0: 6b 20 6f 29 29 0a 28 64 65 66 69 6e 65 20 28 63 k o)).(define (c
3ec0: 70 70 2d 69 66 64 65 66 20 63 68 65 63 6b 20 2e pp-ifdef check .
3ed0: 20 6f 29 0a 20 20 28 61 70 70 6c 79 20 63 70 70 o). (apply cpp
3ee0: 2d 69 66 2f 61 75 78 20 22 69 66 64 65 66 22 20 -if/aux "ifdef"
3ef0: 63 68 65 63 6b 20 6f 29 29 0a 28 64 65 66 69 6e check o)).(defin
3f00: 65 20 28 63 70 70 2d 69 66 6e 64 65 66 20 63 68 e (cpp-ifndef ch
3f10: 65 63 6b 20 2e 20 6f 29 0a 20 20 28 61 70 70 6c eck . o). (appl
3f20: 79 20 63 70 70 2d 69 66 2f 61 75 78 20 22 69 66 y cpp-if/aux "if
3f30: 6e 64 65 66 22 20 63 68 65 63 6b 20 6f 29 29 0a ndef" check o)).
3f40: 28 64 65 66 69 6e 65 20 28 63 70 70 2d 65 6c 69 (define (cpp-eli
3f50: 66 20 63 68 65 63 6b 20 2e 20 6f 29 0a 20 20 28 f check . o). (
3f60: 61 70 70 6c 79 20 63 70 70 2d 69 66 2f 61 75 78 apply cpp-if/aux
3f70: 20 22 65 6c 69 66 22 20 63 68 65 63 6b 20 6f 29 "elif" check o)
3f80: 29 0a 28 64 65 66 69 6e 65 20 28 63 70 70 2d 65 ).(define (cpp-e
3f90: 6c 73 65 20 2e 20 6f 29 0a 20 20 28 63 61 74 20 lse . o). (cat
3fa0: 66 6c 20 22 23 65 6c 73 65 20 22 20 28 69 66 20 fl "#else " (if
3fb0: 28 70 61 69 72 3f 20 6f 29 20 28 63 2d 63 6f 6d (pair? o) (c-com
3fc0: 6d 65 6e 74 20 28 63 61 72 20 6f 29 29 20 22 22 ment (car o)) ""
3fd0: 29 20 66 6c 29 29 0a 28 64 65 66 69 6e 65 20 28 ) fl)).(define (
3fe0: 63 70 70 2d 65 6e 64 69 66 20 2e 20 6f 29 0a 20 cpp-endif . o).
3ff0: 20 28 63 61 74 20 66 6c 20 22 23 65 6e 64 69 66 (cat fl "#endif
4000: 20 22 20 28 69 66 20 28 70 61 69 72 3f 20 6f 29 " (if (pair? o)
4010: 20 28 63 2d 63 6f 6d 6d 65 6e 74 20 28 63 61 72 (c-comment (car
4020: 20 6f 29 29 20 22 22 29 20 66 6c 29 29 0a 0a 28 o)) "") fl))..(
4030: 64 65 66 69 6e 65 20 28 63 70 70 2d 77 72 61 70 define (cpp-wrap
4040: 2d 68 65 61 64 65 72 20 6e 61 6d 65 20 2e 20 62 -header name . b
4050: 6f 64 79 29 0a 20 20 28 6c 65 74 20 28 28 6e 61 ody). (let ((na
4060: 6d 65 20 6e 61 6d 65 29 29 20 3b 20 63 6f 6e 73 me name)) ; cons
4070: 69 64 65 72 20 61 75 74 6f 2d 6d 61 6e 67 6c 69 ider auto-mangli
4080: 6e 67 0a 20 20 20 20 28 63 70 70 2d 69 66 6e 64 ng. (cpp-ifnd
4090: 65 66 20 6e 61 6d 65 20 28 63 2d 62 65 67 69 6e ef name (c-begin
40a0: 20 28 63 70 70 2d 64 65 66 69 6e 65 20 6e 61 6d (cpp-define nam
40b0: 65 29 20 6e 6c 20 28 61 70 70 6c 79 20 63 2d 62 e) nl (apply c-b
40c0: 65 67 69 6e 20 62 6f 64 79 29 20 6e 6c 29 29 29 egin body) nl)))
40d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 70 70 2d )..(define (cpp-
40e0: 6c 69 6e 65 20 6e 75 6d 20 2e 20 6f 29 0a 20 20 line num . o).
40f0: 28 63 61 74 20 66 6c 20 22 23 6c 69 6e 65 20 22 (cat fl "#line "
4100: 20 6e 75 6d 20 28 69 66 20 28 70 61 69 72 3f 20 num (if (pair?
4110: 6f 29 20 28 63 61 74 20 22 20 22 20 28 63 61 72 o) (cat " " (car
4120: 20 6f 29 29 20 22 22 29 20 66 6c 29 29 0a 0a 28 o)) "") fl))..(
4130: 64 65 66 69 6e 65 20 28 63 70 70 2d 67 65 6e 65 define (cpp-gene
4140: 72 69 63 20 6e 61 6d 65 20 2e 20 6c 73 29 0a 20 ric name . ls).
4150: 20 28 63 61 74 20 66 6c 20 22 23 22 20 6e 61 6d (cat fl "#" nam
4160: 65 20 28 61 70 70 6c 79 2d 63 61 74 20 6c 73 29 e (apply-cat ls)
4170: 20 66 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 fl))..(define (
4180: 63 70 70 2d 75 6e 64 65 66 20 2e 20 61 72 67 73 cpp-undef . args
4190: 29 20 28 61 70 70 6c 79 20 63 70 70 2d 67 65 6e ) (apply cpp-gen
41a0: 65 72 69 63 20 22 75 6e 64 65 66 22 20 61 72 67 eric "undef" arg
41b0: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 70 70 s)).(define (cpp
41c0: 2d 70 72 61 67 6d 61 20 2e 20 61 72 67 73 29 20 -pragma . args)
41d0: 28 61 70 70 6c 79 20 63 70 70 2d 67 65 6e 65 72 (apply cpp-gener
41e0: 69 63 20 22 70 72 61 67 6d 61 22 20 61 72 67 73 ic "pragma" args
41f0: 29 29 0a 28 64 65 66 69 6e 65 20 28 63 70 70 2d )).(define (cpp-
4200: 65 72 72 6f 72 20 2e 20 61 72 67 73 29 20 28 61 error . args) (a
4210: 70 70 6c 79 20 63 70 70 2d 67 65 6e 65 72 69 63 pply cpp-generic
4220: 20 22 65 72 72 6f 72 22 20 61 72 67 73 29 29 0a "error" args)).
4230: 28 64 65 66 69 6e 65 20 28 63 70 70 2d 77 61 72 (define (cpp-war
4240: 6e 69 6e 67 20 2e 20 61 72 67 73 29 20 28 61 70 ning . args) (ap
4250: 70 6c 79 20 63 70 70 2d 67 65 6e 65 72 69 63 20 ply cpp-generic
4260: 22 77 61 72 6e 69 6e 67 22 20 61 72 67 73 29 29 "warning" args))
4270: 0a 0a 28 64 65 66 69 6e 65 20 28 63 70 70 2d 73 ..(define (cpp-s
4280: 74 72 69 6e 67 69 66 79 20 78 29 0a 20 20 28 63 tringify x). (c
4290: 61 74 20 22 23 22 20 78 29 29 0a 0a 28 64 65 66 at "#" x))..(def
42a0: 69 6e 65 20 28 63 70 70 2d 73 79 6d 2d 63 61 74 ine (cpp-sym-cat
42b0: 20 2e 20 61 72 67 73 29 0a 20 20 28 66 6d 74 2d . args). (fmt-
42c0: 6a 6f 69 6e 20 64 73 70 20 61 72 67 73 20 22 20 join dsp args "
42d0: 23 23 20 22 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b ## "))..;;;;;;;;
42e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
42f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4300: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4310: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4320: 0a 3b 3b 20 67 65 6e 65 72 61 6c 20 69 6e 64 65 .;; general inde
4330: 6e 74 61 74 69 6f 6e 20 61 6e 64 20 62 72 61 63 ntation and brac
4340: 65 20 72 75 6c 65 73 0a 0a 28 64 65 66 69 6e 65 e rules..(define
4350: 20 28 63 2d 63 75 72 72 65 6e 74 2d 69 6e 64 65 (c-current-inde
4360: 6e 74 2d 73 74 72 69 6e 67 20 73 74 20 2e 20 6f nt-string st . o
4370: 29 0a 20 20 28 6d 61 6b 65 2d 73 70 61 63 65 20 ). (make-space
4380: 28 6d 61 78 20 30 20 28 2b 20 28 66 6d 74 2d 63 (max 0 (+ (fmt-c
4390: 6f 6c 20 73 74 29 20 28 69 66 20 28 70 61 69 72 ol st) (if (pair
43a0: 3f 20 6f 29 20 28 63 61 72 20 6f 29 20 30 29 29 ? o) (car o) 0))
43b0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d )))..(define (c-
43c0: 69 6e 64 65 6e 74 20 73 74 20 2e 20 6f 29 0a 20 indent st . o).
43d0: 20 28 64 73 70 20 28 6d 61 6b 65 2d 73 70 61 63 (dsp (make-spac
43e0: 65 20 28 6d 61 78 20 30 20 28 2b 20 28 66 6d 74 e (max 0 (+ (fmt
43f0: 2d 63 6f 6c 20 73 74 29 20 28 6f 72 20 28 66 6d -col st) (or (fm
4400: 74 2d 69 6e 64 65 6e 74 2d 73 70 61 63 65 20 73 t-indent-space s
4410: 74 29 20 34 29 0a 20 20 20 20 20 20 20 20 20 20 t) 4).
4420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4430: 20 20 20 28 69 66 20 28 70 61 69 72 3f 20 6f 29 (if (pair? o)
4440: 20 28 63 61 72 20 6f 29 20 30 29 29 29 29 29 29 (car o) 0))))))
4450: 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 69 6e 64 ..(define (c-ind
4460: 65 6e 74 2f 73 77 69 74 63 68 20 73 74 29 0a 20 ent/switch st).
4470: 20 28 64 73 70 20 28 6d 61 6b 65 2d 73 70 61 63 (dsp (make-spac
4480: 65 20 28 2b 20 28 66 6d 74 2d 63 6f 6c 20 73 74 e (+ (fmt-col st
4490: 29 20 28 6f 72 20 28 66 6d 74 2d 73 77 69 74 63 ) (or (fmt-switc
44a0: 68 2d 69 6e 64 65 6e 74 2d 73 70 61 63 65 20 73 h-indent-space s
44b0: 74 29 20 34 29 29 29 29 29 0a 0a 28 64 65 66 69 t) 4)))))..(defi
44c0: 6e 65 20 28 63 2d 6f 70 65 6e 2d 62 72 61 63 65 ne (c-open-brace
44d0: 20 73 74 29 0a 20 20 28 69 66 20 28 66 6d 74 2d st). (if (fmt-
44e0: 6e 65 77 6c 69 6e 65 2d 62 65 66 6f 72 65 2d 62 newline-before-b
44f0: 72 61 63 65 3f 20 73 74 29 0a 20 20 20 20 20 20 race? st).
4500: 28 63 61 74 20 6e 6c 20 28 63 2d 63 75 72 72 65 (cat nl (c-curre
4510: 6e 74 2d 69 6e 64 65 6e 74 2d 73 74 72 69 6e 67 nt-indent-string
4520: 20 73 74 29 20 22 7b 22 20 6e 6c 29 0a 20 20 20 st) "{" nl).
4530: 20 20 20 28 63 61 74 20 22 20 7b 22 20 6e 6c 29 (cat " {" nl)
4540: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 63 ))..(define (c-c
4550: 6c 6f 73 65 2d 62 72 61 63 65 20 73 74 29 0a 20 lose-brace st).
4560: 20 28 64 73 70 20 22 7d 22 29 29 0a 0a 28 64 65 (dsp "}"))..(de
4570: 66 69 6e 65 20 28 63 2d 77 72 61 70 2d 73 74 6d fine (c-wrap-stm
4580: 74 20 78 29 0a 20 20 28 66 6d 74 2d 69 66 20 66 t x). (fmt-if f
4590: 6d 74 2d 65 78 70 72 65 73 73 69 6f 6e 3f 0a 20 mt-expression?.
45a0: 20 20 20 20 20 20 20 20 20 28 63 2d 65 78 70 72 (c-expr
45b0: 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 28 63 x). (c
45c0: 61 74 20 28 66 6d 74 2d 69 66 20 66 6d 74 2d 72 at (fmt-if fmt-r
45d0: 65 74 75 72 6e 3f 20 22 72 65 74 75 72 6e 20 22 eturn? "return "
45e0: 20 22 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 "").
45f0: 20 20 20 20 28 63 2d 69 6e 2d 65 78 70 72 20 28 (c-in-expr (
4600: 63 2d 65 78 70 72 20 78 29 29 20 22 3b 22 20 6e c-expr x)) ";" n
4610: 6c 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b l)))..;;;;;;;;;;
4620: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4630: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4640: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4650: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b ;;;;;;;;;;;;;;.;
4660: 3b 20 63 6f 64 65 20 62 6c 6f 63 6b 73 0a 0a 28 ; code blocks..(
4670: 64 65 66 69 6e 65 20 28 63 2d 62 6c 6f 63 6b 20 define (c-block
4680: 2e 20 61 72 67 73 29 0a 20 20 28 61 70 70 6c 79 . args). (apply
4690: 20 63 2d 62 6c 6f 63 6b 2f 61 75 78 20 30 20 61 c-block/aux 0 a
46a0: 72 67 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 rgs))..(define (
46b0: 63 2d 62 6c 6f 63 6b 2f 61 75 78 20 6f 66 66 73 c-block/aux offs
46c0: 65 74 20 68 65 61 64 65 72 20 62 6f 64 79 30 20 et header body0
46d0: 2e 20 62 6f 64 79 29 0a 20 20 20 28 6c 65 74 20 . body). (let
46e0: 28 28 69 6e 6e 65 72 20 28 61 70 70 6c 79 20 63 ((inner (apply c
46f0: 2d 62 65 67 69 6e 20 62 6f 64 79 30 20 62 6f 64 -begin body0 bod
4700: 79 29 29 29 0a 20 20 20 20 20 28 69 66 20 28 6f y))). (if (o
4710: 72 20 28 70 61 69 72 3f 20 62 6f 64 79 29 0a 20 r (pair? body).
4720: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 (not
4730: 20 28 6f 72 20 28 63 2d 6c 69 74 65 72 61 6c 3f (or (c-literal?
4740: 20 62 6f 64 79 30 29 0a 20 20 20 20 20 20 20 20 body0).
4750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
4760: 6e 64 20 28 70 61 69 72 3f 20 62 6f 64 79 30 29 nd (pair? body0)
4770: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4780: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 (not
4790: 20 28 63 2d 63 6f 6e 74 72 6f 6c 2d 6f 70 65 72 (c-control-oper
47a0: 61 74 6f 72 3f 20 28 63 61 72 20 62 6f 64 79 30 ator? (car body0
47b0: 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ))))))).
47c0: 20 28 63 2d 62 72 61 63 65 64 2d 62 6c 6f 63 6b (c-braced-block
47d0: 2f 61 75 78 20 6f 66 66 73 65 74 20 68 65 61 64 /aux offset head
47e0: 65 72 20 69 6e 6e 65 72 29 0a 20 20 20 20 20 20 er inner).
47f0: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 29 0a (lambda (st).
4800: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
4810: 66 6d 74 2d 62 72 61 63 65 6c 65 73 73 2d 62 6f fmt-braceless-bo
4820: 64 69 65 73 3f 20 73 74 29 0a 20 20 20 20 20 20 dies? st).
4830: 20 20 20 20 20 20 20 20 20 28 28 63 61 74 20 68 ((cat h
4840: 65 61 64 65 72 20 66 6c 20 28 63 2d 69 6e 64 65 eader fl (c-inde
4850: 6e 74 20 73 74 20 6f 66 66 73 65 74 29 20 69 6e nt st offset) in
4860: 6e 65 72 20 66 6c 29 20 73 74 29 0a 20 20 20 20 ner fl) st).
4870: 20 20 20 20 20 20 20 20 20 20 20 28 28 63 2d 62 ((c-b
4880: 72 61 63 65 64 2d 62 6c 6f 63 6b 2f 61 75 78 20 raced-block/aux
4890: 6f 66 66 73 65 74 20 68 65 61 64 65 72 20 69 6e offset header in
48a0: 6e 65 72 29 20 73 74 29 29 29 29 29 29 0a 0a 28 ner) st))))))..(
48b0: 64 65 66 69 6e 65 20 28 63 2d 62 72 61 63 65 64 define (c-braced
48c0: 2d 62 6c 6f 63 6b 20 2e 20 61 72 67 73 29 0a 20 -block . args).
48d0: 20 28 61 70 70 6c 79 20 63 2d 62 72 61 63 65 64 (apply c-braced
48e0: 2d 62 6c 6f 63 6b 2f 61 75 78 20 30 20 61 72 67 -block/aux 0 arg
48f0: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d s))..(define (c-
4900: 62 72 61 63 65 64 2d 62 6c 6f 63 6b 2f 61 75 78 braced-block/aux
4910: 20 6f 66 66 73 65 74 20 68 65 61 64 65 72 20 2e offset header .
4920: 20 62 6f 64 79 29 0a 20 20 20 28 6c 61 6d 62 64 body). (lambd
4930: 61 20 28 73 74 29 0a 20 20 20 20 20 28 28 63 61 a (st). ((ca
4940: 74 20 68 65 61 64 65 72 20 28 63 2d 6f 70 65 6e t header (c-open
4950: 2d 62 72 61 63 65 20 73 74 29 20 28 63 2d 69 6e -brace st) (c-in
4960: 64 65 6e 74 20 73 74 20 6f 66 66 73 65 74 29 0a dent st offset).
4970: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
4980: 79 20 63 2d 62 65 67 69 6e 20 62 6f 64 79 29 20 y c-begin body)
4990: 66 6c 0a 20 20 20 20 20 20 20 20 20 20 20 28 63 fl. (c
49a0: 2d 63 75 72 72 65 6e 74 2d 69 6e 64 65 6e 74 2d -current-indent-
49b0: 73 74 72 69 6e 67 20 73 74 20 6f 66 66 73 65 74 string st offset
49c0: 29 20 28 63 2d 63 6c 6f 73 65 2d 62 72 61 63 65 ) (c-close-brace
49d0: 20 73 74 29 29 0a 20 20 20 20 20 20 73 74 29 29 st)). st))
49e0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 62 65 )..(define (c-be
49f0: 67 69 6e 20 2e 20 61 72 67 73 29 0a 20 20 28 61 gin . args). (a
4a00: 70 70 6c 79 20 63 2d 62 65 67 69 6e 2f 61 75 78 pply c-begin/aux
4a10: 20 23 66 20 61 72 67 73 29 29 0a 0a 28 64 65 66 #f args))..(def
4a20: 69 6e 65 20 28 63 2d 62 65 67 69 6e 2f 61 75 78 ine (c-begin/aux
4a30: 20 72 65 74 3f 20 62 6f 64 79 30 20 2e 20 62 6f ret? body0 . bo
4a40: 64 79 29 0a 20 20 20 28 69 66 20 28 6e 75 6c 6c dy). (if (null
4a50: 3f 20 62 6f 64 79 29 0a 20 20 20 20 20 20 20 28 ? body). (
4a60: 63 2d 65 78 70 72 20 62 6f 64 79 30 29 0a 20 20 c-expr body0).
4a70: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 (lambda (st
4a80: 29 0a 20 20 20 20 20 20 20 20 20 28 69 66 20 28 ). (if (
4a90: 66 6d 74 2d 65 78 70 72 65 73 73 69 6f 6e 3f 20 fmt-expression?
4aa0: 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 st).
4ab0: 20 28 28 66 6d 74 2d 74 72 79 2d 66 69 74 0a 20 ((fmt-try-fit.
4ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
4ad0: 6d 74 2d 6c 65 74 20 27 6e 6f 2d 77 72 61 70 3f mt-let 'no-wrap?
4ae0: 20 23 74 20 28 66 6d 74 2d 6a 6f 69 6e 20 63 2d #t (fmt-join c-
4af0: 65 78 70 72 20 28 63 6f 6e 73 20 62 6f 64 79 30 expr (cons body0
4b00: 20 62 6f 64 79 29 20 22 2c 20 22 29 29 0a 20 20 body) ", ")).
4b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
4b20: 6d 62 64 61 20 28 73 74 29 0a 20 20 20 20 20 20 mbda (st).
4b30: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
4b40: 28 28 69 6e 64 65 6e 74 20 28 63 2d 63 75 72 72 ((indent (c-curr
4b50: 65 6e 74 2d 69 6e 64 65 6e 74 2d 73 74 72 69 6e ent-indent-strin
4b60: 67 20 73 74 29 29 29 0a 20 20 20 20 20 20 20 20 g st))).
4b70: 20 20 20 20 20 20 20 20 20 20 20 28 28 66 6d 74 ((fmt
4b80: 2d 6a 6f 69 6e 20 63 2d 65 78 70 72 20 28 63 6f -join c-expr (co
4b90: 6e 73 20 62 6f 64 79 30 20 62 6f 64 79 29 20 28 ns body0 body) (
4ba0: 63 61 74 20 22 2c 22 20 6e 6c 20 69 6e 64 65 6e cat "," nl inden
4bb0: 74 29 29 20 73 74 29 29 29 29 0a 20 20 20 20 20 t)) st)))).
4bc0: 20 20 20 20 20 20 20 20 20 73 74 29 0a 20 20 20 st).
4bd0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
4be0: 28 6f 72 69 67 2d 72 65 74 3f 20 28 66 6d 74 2d (orig-ret? (fmt-
4bf0: 72 65 74 75 72 6e 3f 20 73 74 29 29 29 0a 20 20 return? st))).
4c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 66 ((f
4c10: 6d 74 2d 6a 6f 69 6e 2f 6c 61 73 74 20 63 2d 65 mt-join/last c-e
4c20: 78 70 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 xpr.
4c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c40: 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 20 28 (lambda (x) (
4c50: 66 6d 74 2d 6c 65 74 20 27 72 65 74 75 72 6e 3f fmt-let 'return?
4c60: 20 6f 72 69 67 2d 72 65 74 3f 20 28 63 2d 65 78 orig-ret? (c-ex
4c70: 70 72 20 78 29 29 29 0a 20 20 20 20 20 20 20 20 pr x))).
4c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c90: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 62 6f 64 (cons bod
4ca0: 79 30 20 62 6f 64 79 29 0a 20 20 20 20 20 20 20 y0 body).
4cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cc0: 20 20 20 20 20 20 20 20 28 63 61 74 20 66 6c 20 (cat fl
4cd0: 28 63 2d 63 75 72 72 65 6e 74 2d 69 6e 64 65 6e (c-current-inden
4ce0: 74 2d 73 74 72 69 6e 67 20 73 74 29 29 29 0a 20 t-string st))).
4cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4d00: 66 6d 74 2d 73 65 74 21 20 73 74 20 27 72 65 74 fmt-set! st 'ret
4d10: 75 72 6e 3f 20 28 61 6e 64 20 72 65 74 3f 20 6f urn? (and ret? o
4d20: 72 69 67 2d 72 65 74 3f 29 29 29 29 29 29 29 29 rig-ret?))))))))
4d30: 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ..;;;;;;;;;;;;;;
4d40: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4d50: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4d60: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4d70: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 64 61 ;;;;;;;;;;.;; da
4d80: 74 61 20 73 74 72 75 63 74 75 72 65 73 0a 0a 28 ta structures..(
4d90: 64 65 66 69 6e 65 20 28 63 2d 73 74 72 75 63 74 define (c-struct
4da0: 2f 61 75 78 20 74 79 70 65 20 78 20 2e 20 6f 29 /aux type x . o)
4db0: 0a 20 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 . (let* ((name
4dc0: 28 69 66 20 28 6e 75 6c 6c 3f 20 6f 29 20 28 69 (if (null? o) (i
4dd0: 66 20 28 6f 72 20 28 73 79 6d 62 6f 6c 3f 20 78 f (or (symbol? x
4de0: 29 20 28 73 74 72 69 6e 67 3f 20 78 29 29 20 78 ) (string? x)) x
4df0: 20 23 66 29 20 78 29 29 0a 20 20 20 20 20 20 20 #f) x)).
4e00: 20 20 28 62 6f 64 79 20 28 69 66 20 6e 61 6d 65 (body (if name
4e10: 20 28 63 61 72 20 6f 29 20 78 29 29 0a 20 20 20 (car o) x)).
4e20: 20 20 20 20 20 20 28 6f 20 28 69 66 20 28 6e 75 (o (if (nu
4e30: 6c 6c 3f 20 6f 29 20 6f 20 28 63 64 72 20 6f 29 ll? o) o (cdr o)
4e40: 29 29 29 0a 20 20 20 20 28 63 2d 77 72 61 70 2d ))). (c-wrap-
4e50: 73 74 6d 74 0a 20 20 20 20 20 28 63 61 74 0a 20 stmt. (cat.
4e60: 20 20 20 20 20 28 63 2d 62 72 61 63 65 64 2d 62 (c-braced-b
4e70: 6c 6f 63 6b 0a 20 20 20 20 20 20 20 28 63 61 74 lock. (cat
4e80: 20 74 79 70 65 20 28 69 66 20 28 61 6e 64 20 6e type (if (and n
4e90: 61 6d 65 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f ame (not (equal?
4ea0: 20 6e 61 6d 65 20 22 22 29 29 29 20 28 63 61 74 name ""))) (cat
4eb0: 20 22 20 22 20 6e 61 6d 65 29 20 22 22 29 29 0a " " name) "")).
4ec0: 20 20 20 20 20 20 20 28 63 61 74 0a 20 20 20 20 (cat.
4ed0: 20 20 20 20 28 63 2d 69 6e 2d 73 74 6d 74 0a 20 (c-in-stmt.
4ee0: 20 20 20 20 20 20 20 20 28 69 66 20 28 6c 69 73 (if (lis
4ef0: 74 3f 20 62 6f 64 79 29 0a 20 20 20 20 20 20 20 t? body).
4f00: 20 20 20 20 20 20 28 61 70 70 6c 79 20 63 2d 62 (apply c-b
4f10: 65 67 69 6e 20 28 6d 61 70 20 63 2d 77 72 61 70 egin (map c-wrap
4f20: 2d 73 74 6d 74 20 28 6d 61 70 20 63 2d 70 61 72 -stmt (map c-par
4f30: 61 6d 20 62 6f 64 79 29 29 29 0a 20 20 20 20 20 am body))).
4f40: 20 20 20 20 20 20 20 20 28 63 2d 77 72 61 70 2d (c-wrap-
4f50: 73 74 6d 74 20 28 63 2d 65 78 70 72 20 62 6f 64 stmt (c-expr bod
4f60: 79 29 29 29 29 29 29 0a 20 20 20 20 20 20 28 69 y)))))). (i
4f70: 66 20 28 70 61 69 72 3f 20 6f 29 20 28 63 61 74 f (pair? o) (cat
4f80: 20 22 20 22 20 28 61 70 70 6c 79 20 63 2d 62 65 " " (apply c-be
4f90: 67 69 6e 20 6f 29 29 20 28 64 73 70 20 22 22 29 gin o)) (dsp "")
4fa0: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
4fb0: 63 2d 73 74 72 75 63 74 20 2e 20 61 72 67 73 29 c-struct . args)
4fc0: 20 28 61 70 70 6c 79 20 63 2d 73 74 72 75 63 74 (apply c-struct
4fd0: 2f 61 75 78 20 22 73 74 72 75 63 74 22 20 61 72 /aux "struct" ar
4fe0: 67 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 2d gs)).(define (c-
4ff0: 75 6e 69 6f 6e 20 2e 20 61 72 67 73 29 20 28 61 union . args) (a
5000: 70 70 6c 79 20 63 2d 73 74 72 75 63 74 2f 61 75 pply c-struct/au
5010: 78 20 22 75 6e 69 6f 6e 22 20 61 72 67 73 29 29 x "union" args))
5020: 0a 28 64 65 66 69 6e 65 20 28 63 2d 63 6c 61 73 .(define (c-clas
5030: 73 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c 79 s . args) (apply
5040: 20 63 2d 73 74 72 75 63 74 2f 61 75 78 20 22 63 c-struct/aux "c
5050: 6c 61 73 73 22 20 61 72 67 73 29 29 0a 0a 28 64 lass" args))..(d
5060: 65 66 69 6e 65 20 28 63 2d 65 6e 75 6d 20 78 20 efine (c-enum x
5070: 2e 20 6f 29 0a 20 20 28 64 65 66 69 6e 65 20 28 . o). (define (
5080: 63 2d 65 6e 75 6d 2d 6f 6e 65 20 78 29 0a 20 20 c-enum-one x).
5090: 20 20 28 69 66 20 28 70 61 69 72 3f 20 78 29 20 (if (pair? x)
50a0: 28 63 61 74 20 28 63 61 72 20 78 29 20 22 20 3d (cat (car x) " =
50b0: 20 22 20 28 63 2d 65 78 70 72 20 28 63 61 64 72 " (c-expr (cadr
50c0: 20 78 29 29 29 20 28 64 73 70 20 78 29 29 29 0a x))) (dsp x))).
50d0: 20 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 28 (let* ((name (
50e0: 69 66 20 28 6e 75 6c 6c 3f 20 6f 29 20 28 69 66 if (null? o) (if
50f0: 20 28 6f 72 20 28 73 79 6d 62 6f 6c 3f 20 78 29 (or (symbol? x)
5100: 20 28 73 74 72 69 6e 67 3f 20 78 29 29 20 78 20 (string? x)) x
5110: 23 66 29 20 78 29 29 0a 20 20 20 20 20 20 20 20 #f) x)).
5120: 20 28 76 61 6c 73 20 28 69 66 20 6e 61 6d 65 20 (vals (if name
5130: 28 63 61 72 20 6f 29 20 78 29 29 29 0a 20 20 20 (car o) x))).
5140: 20 28 63 2d 77 72 61 70 2d 73 74 6d 74 0a 20 20 (c-wrap-stmt.
5150: 20 20 20 28 63 61 74 0a 20 20 20 20 20 20 28 63 (cat. (c
5160: 2d 62 72 61 63 65 64 2d 62 6c 6f 63 6b 0a 20 20 -braced-block.
5170: 20 20 20 20 20 28 69 66 20 6e 61 6d 65 20 28 63 (if name (c
5180: 61 74 20 22 65 6e 75 6d 20 22 20 6e 61 6d 65 29 at "enum " name)
5190: 20 28 64 73 70 20 22 65 6e 75 6d 22 29 29 0a 20 (dsp "enum")).
51a0: 20 20 20 20 20 20 28 63 2d 69 6e 2d 65 78 70 72 (c-in-expr
51b0: 20 28 61 70 70 6c 79 20 63 2d 62 65 67 69 6e 20 (apply c-begin
51c0: 28 6d 61 70 20 63 2d 65 6e 75 6d 2d 6f 6e 65 20 (map c-enum-one
51d0: 76 61 6c 73 29 29 29 29 29 29 29 29 0a 0a 28 64 vals))))))))..(d
51e0: 65 66 69 6e 65 20 28 63 2d 61 74 74 72 69 62 75 efine (c-attribu
51f0: 74 65 20 2e 20 61 72 67 73 29 0a 20 20 28 63 61 te . args). (ca
5200: 74 20 22 5f 5f 61 74 74 72 69 62 75 74 65 5f 5f t "__attribute__
5210: 20 28 28 22 20 28 66 6d 74 2d 6a 6f 69 6e 20 63 ((" (fmt-join c
5220: 2d 65 78 70 72 20 61 72 67 73 20 22 2c 20 22 29 -expr args ", ")
5230: 20 22 29 29 22 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b "))"))..;;;;;;;
5240: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5250: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5260: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5270: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5280: 3b 0a 3b 3b 20 62 61 73 69 63 20 63 6f 6e 74 72 ;.;; basic contr
5290: 6f 6c 20 73 74 72 75 63 74 75 72 65 73 0a 0a 28 ol structures..(
52a0: 64 65 66 69 6e 65 20 28 63 2d 77 68 69 6c 65 20 define (c-while
52b0: 63 68 65 63 6b 20 2e 20 62 6f 64 79 29 0a 20 20 check . body).
52c0: 28 63 61 74 20 28 63 2d 62 6c 6f 63 6b 20 28 63 (cat (c-block (c
52d0: 61 74 20 22 77 68 69 6c 65 20 28 22 20 28 63 2d at "while (" (c-
52e0: 69 6e 2d 74 65 73 74 20 28 63 2d 65 78 70 72 20 in-test (c-expr
52f0: 63 68 65 63 6b 29 29 20 22 29 22 29 0a 20 20 20 check)) ")").
5300: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 2d (c-
5310: 69 6e 2d 73 74 6d 74 20 28 61 70 70 6c 79 20 63 in-stmt (apply c
5320: 2d 62 65 67 69 6e 20 62 6f 64 79 29 29 29 0a 20 -begin body))).
5330: 20 20 20 20 20 20 66 6c 29 29 0a 0a 28 64 65 66 fl))..(def
5340: 69 6e 65 20 28 63 2d 66 6f 72 20 69 6e 69 74 20 ine (c-for init
5350: 63 68 65 63 6b 20 75 70 64 61 74 65 20 2e 20 62 check update . b
5360: 6f 64 79 29 0a 20 20 28 63 61 74 0a 20 20 20 28 ody). (cat. (
5370: 63 2d 62 6c 6f 63 6b 0a 20 20 20 20 28 63 2d 69 c-block. (c-i
5380: 6e 2d 65 78 70 72 0a 20 20 20 20 20 28 63 61 74 n-expr. (cat
5390: 20 22 66 6f 72 20 28 22 20 28 63 2d 65 78 70 72 "for (" (c-expr
53a0: 20 69 6e 69 74 29 20 22 3b 20 22 20 28 63 2d 69 init) "; " (c-i
53b0: 6e 2d 74 65 73 74 20 28 63 2d 65 78 70 72 20 63 n-test (c-expr c
53c0: 68 65 63 6b 29 29 20 22 3b 20 22 0a 20 20 20 20 heck)) "; ".
53d0: 20 20 20 20 20 20 28 63 2d 65 78 70 72 20 75 70 (c-expr up
53e0: 64 61 74 65 20 29 20 22 29 22 29 29 0a 20 20 20 date ) ")")).
53f0: 20 28 63 2d 69 6e 2d 73 74 6d 74 20 28 61 70 70 (c-in-stmt (app
5400: 6c 79 20 63 2d 62 65 67 69 6e 20 62 6f 64 79 29 ly c-begin body)
5410: 29 29 0a 20 20 20 66 6c 29 29 0a 0a 28 64 65 66 )). fl))..(def
5420: 69 6e 65 20 28 63 2d 70 61 72 61 6d 20 78 29 0a ine (c-param x).
5430: 20 20 28 63 6f 6e 64 0a 20 20 20 20 28 28 70 72 (cond. ((pr
5440: 6f 63 65 64 75 72 65 3f 20 78 29 20 78 29 0a 20 ocedure? x) x).
5450: 20 20 20 28 28 70 61 69 72 3f 20 78 29 20 28 63 ((pair? x) (c
5460: 2d 74 79 70 65 20 28 63 61 72 20 78 29 20 28 63 -type (car x) (c
5470: 61 64 72 20 78 29 29 29 0a 20 20 20 20 28 65 6c adr x))). (el
5480: 73 65 20 28 63 61 74 20 28 6c 61 6d 62 64 61 20 se (cat (lambda
5490: 28 73 74 29 20 28 28 63 2d 74 79 70 65 20 28 66 (st) ((c-type (f
54a0: 6d 74 2d 64 65 66 61 75 6c 74 2d 74 79 70 65 20 mt-default-type
54b0: 73 74 29 29 20 73 74 29 29 20 22 20 22 20 78 29 st)) st)) " " x)
54c0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d )))..(define (c-
54d0: 70 61 72 61 6d 2d 6c 69 73 74 20 6c 73 29 0a 20 param-list ls).
54e0: 20 28 63 2d 69 6e 2d 65 78 70 72 20 28 66 6d 74 (c-in-expr (fmt
54f0: 2d 6a 6f 69 6e 2f 64 6f 74 20 63 2d 70 61 72 61 -join/dot c-para
5500: 6d 20 28 6c 61 6d 62 64 61 20 28 64 6f 74 29 20 m (lambda (dot)
5510: 28 64 73 70 20 22 2e 2e 2e 22 29 29 20 6c 73 20 (dsp "...")) ls
5520: 22 2c 20 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 ", ")))..(define
5530: 20 28 63 2d 66 75 6e 20 74 79 70 65 20 6e 61 6d (c-fun type nam
5540: 65 20 70 61 72 61 6d 73 20 2e 20 62 6f 64 79 29 e params . body)
5550: 0a 20 20 28 63 61 74 20 28 63 2d 62 6c 6f 63 6b . (cat (c-block
5560: 20 28 63 2d 69 6e 2d 65 78 70 72 20 28 63 2d 70 (c-in-expr (c-p
5570: 72 6f 74 6f 74 79 70 65 20 74 79 70 65 20 6e 61 rototype type na
5580: 6d 65 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 me params)).
5590: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6d 74 (fmt
55a0: 2d 6c 65 74 20 27 72 65 74 75 72 6e 3f 20 28 6e -let 'return? (n
55b0: 6f 74 20 28 65 71 3f 20 27 76 6f 69 64 20 74 79 ot (eq? 'void ty
55c0: 70 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 pe)).
55d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
55e0: 2d 69 6e 2d 73 74 6d 74 20 28 61 70 70 6c 79 20 -in-stmt (apply
55f0: 63 2d 62 65 67 69 6e 20 62 6f 64 79 29 29 29 29 c-begin body))))
5600: 0a 20 20 20 20 20 20 20 66 6c 29 29 0a 0a 28 64 . fl))..(d
5610: 65 66 69 6e 65 20 28 63 2d 70 72 6f 74 6f 74 79 efine (c-prototy
5620: 70 65 20 74 79 70 65 20 6e 61 6d 65 20 70 61 72 pe type name par
5630: 61 6d 73 20 2e 20 6f 29 0a 20 20 28 63 2d 77 72 ams . o). (c-wr
5640: 61 70 2d 73 74 6d 74 0a 20 20 20 28 63 61 74 20 ap-stmt. (cat
5650: 28 63 2d 74 79 70 65 20 74 79 70 65 29 20 22 20 (c-type type) "
5660: 22 20 28 63 2d 65 78 70 72 20 6e 61 6d 65 29 20 " (c-expr name)
5670: 22 20 28 22 20 28 63 2d 70 61 72 61 6d 2d 6c 69 " (" (c-param-li
5680: 73 74 20 70 61 72 61 6d 73 29 20 22 29 22 0a 20 st params) ")".
5690: 20 20 20 20 20 20 20 28 66 6d 74 2d 6a 6f 69 6e (fmt-join
56a0: 2f 70 72 65 66 69 78 20 63 2d 65 78 70 72 20 6f /prefix c-expr o
56b0: 20 22 20 22 29 29 29 29 0a 0a 28 64 65 66 69 6e " "))))..(defin
56c0: 65 20 28 63 2d 73 74 61 74 69 63 20 78 29 20 28 e (c-static x) (
56d0: 63 61 74 20 22 73 74 61 74 69 63 20 22 20 28 63 cat "static " (c
56e0: 2d 65 78 70 72 20 78 29 29 29 0a 28 64 65 66 69 -expr x))).(defi
56f0: 6e 65 20 28 63 2d 63 6f 6e 73 74 20 78 29 20 28 ne (c-const x) (
5700: 63 61 74 20 22 63 6f 6e 73 74 20 22 20 28 63 2d cat "const " (c-
5710: 65 78 70 72 20 78 29 29 29 0a 28 64 65 66 69 6e expr x))).(defin
5720: 65 20 28 63 2d 72 65 73 74 72 69 63 74 20 78 29 e (c-restrict x)
5730: 20 28 63 61 74 20 22 72 65 73 74 72 69 63 74 20 (cat "restrict
5740: 22 20 28 63 2d 65 78 70 72 20 78 29 29 29 0a 28 " (c-expr x))).(
5750: 64 65 66 69 6e 65 20 28 63 2d 76 6f 6c 61 74 69 define (c-volati
5760: 6c 65 20 78 29 20 28 63 61 74 20 22 76 6f 6c 61 le x) (cat "vola
5770: 74 69 6c 65 20 22 20 28 63 2d 65 78 70 72 20 78 tile " (c-expr x
5780: 29 29 29 0a 28 64 65 66 69 6e 65 20 28 63 2d 61 ))).(define (c-a
5790: 75 74 6f 20 78 29 20 28 63 61 74 20 22 61 75 74 uto x) (cat "aut
57a0: 6f 20 22 20 28 63 2d 65 78 70 72 20 78 29 29 29 o " (c-expr x)))
57b0: 0a 28 64 65 66 69 6e 65 20 28 63 2d 69 6e 6c 69 .(define (c-inli
57c0: 6e 65 20 78 29 20 28 63 61 74 20 22 69 6e 6c 69 ne x) (cat "inli
57d0: 6e 65 20 22 20 28 63 2d 65 78 70 72 20 78 29 29 ne " (c-expr x))
57e0: 29 0a 28 64 65 66 69 6e 65 20 28 63 2d 65 78 74 ).(define (c-ext
57f0: 65 72 6e 20 78 29 20 28 63 61 74 20 22 65 78 74 ern x) (cat "ext
5800: 65 72 6e 20 22 20 28 63 2d 65 78 70 72 20 78 29 ern " (c-expr x)
5810: 29 29 0a 28 64 65 66 69 6e 65 20 28 63 2d 65 78 )).(define (c-ex
5820: 74 65 72 6e 2f 43 20 2e 20 62 6f 64 79 29 0a 20 tern/C . body).
5830: 20 28 63 61 74 20 22 65 78 74 65 72 6e 20 5c 22 (cat "extern \"
5840: 43 5c 22 20 7b 22 20 6e 6c 20 28 61 70 70 6c 79 C\" {" nl (apply
5850: 20 63 2d 62 65 67 69 6e 20 62 6f 64 79 29 20 6e c-begin body) n
5860: 6c 20 22 7d 22 20 6e 6c 29 29 0a 0a 28 64 65 66 l "}" nl))..(def
5870: 69 6e 65 20 28 63 2d 74 79 70 65 20 74 79 70 65 ine (c-type type
5880: 20 2e 20 6f 29 0a 20 20 28 6c 65 74 20 28 28 6e . o). (let ((n
5890: 61 6d 65 20 28 61 6e 64 20 28 70 61 69 72 3f 20 ame (and (pair?
58a0: 6f 29 20 28 63 61 72 20 6f 29 29 29 29 0a 20 20 o) (car o)))).
58b0: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 70 (cond. ((p
58c0: 61 69 72 3f 20 74 79 70 65 29 0a 20 20 20 20 20 air? type).
58d0: 20 28 63 61 73 65 20 28 63 61 72 20 74 79 70 65 (case (car type
58e0: 29 0a 20 20 20 20 20 20 20 20 28 28 25 66 75 6e ). ((%fun
58f0: 29 0a 20 20 20 20 20 20 20 20 20 28 63 61 74 20 ). (cat
5900: 28 63 2d 74 79 70 65 20 28 63 61 64 72 20 74 79 (c-type (cadr ty
5910: 70 65 29 20 23 66 29 0a 20 20 20 20 20 20 20 20 pe) #f).
5920: 20 20 20 20 20 20 22 20 28 2a 22 20 28 6f 72 20 " (*" (or
5930: 6e 61 6d 65 20 22 22 29 20 22 29 28 22 0a 20 20 name "") ")(".
5940: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6d 74 (fmt
5950: 2d 6a 6f 69 6e 20 28 6c 61 6d 62 64 61 20 28 78 -join (lambda (x
5960: 29 20 28 63 2d 74 79 70 65 20 78 20 23 66 29 29 ) (c-type x #f))
5970: 20 28 63 61 64 64 72 20 74 79 70 65 29 20 22 2c (caddr type) ",
5980: 20 22 29 20 22 29 22 29 29 0a 20 20 20 20 20 20 ") ")")).
5990: 20 20 28 28 25 61 72 72 61 79 29 0a 20 20 20 20 ((%array).
59a0: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 61 6d 65 (let ((name
59b0: 20 28 63 61 74 20 6e 61 6d 65 20 22 5b 22 20 28 (cat name "[" (
59c0: 69 66 20 28 70 61 69 72 3f 20 28 63 64 64 72 20 if (pair? (cddr
59d0: 74 79 70 65 29 29 0a 20 20 20 20 20 20 20 20 20 type)).
59e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
5a00: 2d 65 78 70 72 20 28 63 61 64 64 72 20 74 79 70 -expr (caddr typ
5a10: 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e)).
5a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a30: 20 20 20 20 20 20 20 20 20 20 20 22 22 29 0a 20 "").
5a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a50: 20 20 20 20 20 20 20 20 20 22 5d 22 29 29 29 0a "]"))).
5a60: 20 20 20 20 20 20 20 20 20 20 20 28 63 2d 74 79 (c-ty
5a70: 70 65 20 28 63 61 64 72 20 74 79 70 65 29 20 6e pe (cadr type) n
5a80: 61 6d 65 29 29 29 0a 20 20 20 20 20 20 20 20 28 ame))). (
5a90: 28 25 70 6f 69 6e 74 65 72 20 2a 29 0a 20 20 20 (%pointer *).
5aa0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 61 6d (let ((nam
5ab0: 65 20 28 63 61 74 20 22 2a 22 20 28 69 66 20 6e e (cat "*" (if n
5ac0: 61 6d 65 20 28 63 2d 65 78 70 72 20 6e 61 6d 65 ame (c-expr name
5ad0: 29 20 22 22 29 29 29 29 0a 20 20 20 20 20 20 20 ) "")))).
5ae0: 20 20 20 20 28 63 2d 74 79 70 65 20 28 63 61 64 (c-type (cad
5af0: 72 20 74 79 70 65 29 0a 20 20 20 20 20 20 20 20 r type).
5b00: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
5b10: 61 6e 64 20 28 70 61 69 72 3f 20 28 63 61 64 72 and (pair? (cadr
5b20: 20 74 79 70 65 29 29 20 28 65 71 3f 20 27 25 61 type)) (eq? '%a
5b30: 72 72 61 79 20 28 63 61 61 64 72 20 74 79 70 65 rray (caadr type
5b40: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
5b50: 20 20 20 20 20 20 20 20 20 20 20 28 63 2d 70 61 (c-pa
5b60: 72 65 6e 20 6e 61 6d 65 29 0a 20 20 20 20 20 20 ren name).
5b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b80: 20 6e 61 6d 65 29 29 29 29 0a 20 20 20 20 20 20 name)))).
5b90: 20 20 28 28 65 6e 75 6d 29 20 28 61 70 70 6c 79 ((enum) (apply
5ba0: 20 63 2d 65 6e 75 6d 20 6e 61 6d 65 20 28 63 64 c-enum name (cd
5bb0: 72 20 74 79 70 65 29 29 29 0a 20 20 20 20 20 20 r type))).
5bc0: 20 20 28 28 73 74 72 75 63 74 20 75 6e 69 6f 6e ((struct union
5bd0: 20 63 6c 61 73 73 29 0a 20 20 20 20 20 20 20 20 class).
5be0: 20 28 63 61 74 20 28 61 70 70 6c 79 20 63 2d 73 (cat (apply c-s
5bf0: 74 72 75 63 74 2f 61 75 78 20 28 63 61 72 20 74 truct/aux (car t
5c00: 79 70 65 29 20 28 63 64 72 20 74 79 70 65 29 29 ype) (cdr type))
5c10: 20 22 20 22 20 6e 61 6d 65 29 29 0a 20 20 20 20 " " name)).
5c20: 20 20 20 20 28 65 6c 73 65 20 28 66 6d 74 2d 6a (else (fmt-j
5c30: 6f 69 6e 2f 6c 61 73 74 20 63 2d 65 78 70 72 20 oin/last c-expr
5c40: 28 6c 61 6d 62 64 61 20 28 78 29 20 28 63 2d 74 (lambda (x) (c-t
5c50: 79 70 65 20 78 20 6e 61 6d 65 29 29 20 74 79 70 ype x name)) typ
5c60: 65 20 22 20 22 29 29 29 29 0a 20 20 20 20 20 28 e " ")))). (
5c70: 28 6e 6f 74 20 74 79 70 65 29 0a 20 20 20 20 20 (not type).
5c80: 20 28 6c 61 6d 62 64 61 20 28 73 74 29 20 28 28 (lambda (st) ((
5c90: 63 2d 74 79 70 65 20 28 6f 72 20 28 66 6d 74 2d c-type (or (fmt-
5ca0: 64 65 66 61 75 6c 74 2d 74 79 70 65 20 73 74 29 default-type st)
5cb0: 20 27 69 6e 74 29 20 6e 61 6d 65 29 20 73 74 29 'int) name) st)
5cc0: 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 )). (else.
5cd0: 20 20 20 20 28 63 61 74 20 28 69 66 20 28 65 71 (cat (if (eq
5ce0: 3f 20 27 25 70 6f 69 6e 74 65 72 20 74 79 70 65 ? '%pointer type
5cf0: 29 20 27 2a 20 74 79 70 65 29 20 28 69 66 20 6e ) '* type) (if n
5d00: 61 6d 65 20 28 63 61 74 20 22 20 22 20 6e 61 6d ame (cat " " nam
5d10: 65 29 20 22 22 29 29 29 29 29 29 0a 0a 28 64 65 e) ""))))))..(de
5d20: 66 69 6e 65 20 28 63 2d 76 61 72 20 74 79 70 65 fine (c-var type
5d30: 20 6e 61 6d 65 20 2e 20 69 6e 69 74 29 0a 20 20 name . init).
5d40: 28 63 2d 77 72 61 70 2d 73 74 6d 74 0a 20 20 20 (c-wrap-stmt.
5d50: 28 69 66 20 28 70 61 69 72 3f 20 69 6e 69 74 29 (if (pair? init)
5d60: 0a 20 20 20 20 20 20 20 28 63 61 74 20 28 63 2d . (cat (c-
5d70: 74 79 70 65 20 74 79 70 65 20 6e 61 6d 65 29 20 type type name)
5d80: 22 20 3d 20 22 20 28 63 2d 65 78 70 72 20 28 63 " = " (c-expr (c
5d90: 61 72 20 69 6e 69 74 29 29 29 0a 20 20 20 20 20 ar init))).
5da0: 20 20 28 63 2d 74 79 70 65 20 74 79 70 65 20 28 (c-type type (
5db0: 69 66 20 28 70 61 69 72 3f 20 6e 61 6d 65 29 0a if (pair? name).
5dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5dd0: 20 20 20 20 20 20 20 20 28 66 6d 74 2d 6a 6f 69 (fmt-joi
5de0: 6e 20 63 2d 65 78 70 72 20 6e 61 6d 65 20 22 2c n c-expr name ",
5df0: 20 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ").
5e00: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 2d 65 (c-e
5e10: 78 70 72 20 6e 61 6d 65 29 29 29 29 29 29 0a 0a xpr name))))))..
5e20: 28 64 65 66 69 6e 65 20 28 63 2d 63 61 73 74 20 (define (c-cast
5e30: 74 79 70 65 20 65 78 70 72 29 0a 20 20 28 63 61 type expr). (ca
5e40: 74 20 22 28 22 20 28 63 2d 74 79 70 65 20 74 79 t "(" (c-type ty
5e50: 70 65 29 20 22 29 22 20 28 63 2d 65 78 70 72 20 pe) ")" (c-expr
5e60: 65 78 70 72 29 29 29 0a 0a 28 64 65 66 69 6e 65 expr)))..(define
5e70: 20 28 63 2d 74 79 70 65 64 65 66 20 74 79 70 65 (c-typedef type
5e80: 20 61 6c 69 61 73 20 2e 20 6f 29 0a 20 20 28 63 alias . o). (c
5e90: 2d 77 72 61 70 2d 73 74 6d 74 0a 20 20 20 28 63 -wrap-stmt. (c
5ea0: 61 74 20 22 74 79 70 65 64 65 66 20 22 20 28 63 at "typedef " (c
5eb0: 2d 74 79 70 65 20 74 79 70 65 20 61 6c 69 61 73 -type type alias
5ec0: 29 20 28 66 6d 74 2d 6a 6f 69 6e 2f 70 72 65 66 ) (fmt-join/pref
5ed0: 69 78 20 63 2d 65 78 70 72 20 6f 20 22 20 22 29 ix c-expr o " ")
5ee0: 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b )))..;;;;;;;;;;;
5ef0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5f00: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5f10: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5f20: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b ;;;;;;;;;;;;;.;;
5f30: 20 47 65 6e 65 72 61 6c 69 7a 65 64 20 49 46 3a Generalized IF:
5f40: 20 61 6c 6c 6f 77 73 20 6d 75 6c 74 69 70 6c 65 allows multiple
5f50: 20 74 61 69 6c 20 66 6f 72 6d 73 20 66 6f 72 20 tail forms for
5f60: 69 66 2f 65 6c 73 65 20 69 66 2f 2e 2e 2e 2f 65 if/else if/.../e
5f70: 6c 73 65 0a 3b 3b 20 62 6c 6f 63 6b 73 2e 20 20 lse.;; blocks.
5f80: 41 20 66 69 6e 61 6c 20 45 4c 53 45 20 63 61 6e A final ELSE can
5f90: 20 62 65 20 73 69 67 6e 69 66 69 65 64 20 77 69 be signified wi
5fa0: 74 68 20 61 20 74 65 73 74 20 6f 66 20 23 74 20 th a test of #t
5fb0: 6f 72 20 27 65 6c 73 65 2c 0a 3b 3b 20 6f 72 20 or 'else,.;; or
5fc0: 62 79 20 73 69 6d 70 6c 79 20 75 73 69 6e 67 20 by simply using
5fd0: 61 6e 20 6f 64 64 20 6e 75 6d 62 65 72 20 6f 66 an odd number of
5fe0: 20 65 78 70 72 65 73 73 69 6f 6e 73 20 28 62 79 expressions (by
5ff0: 20 77 68 69 63 68 20 74 68 65 0a 3b 3b 20 6e 6f which the.;; no
6000: 72 6d 61 6c 20 32 20 6f 72 20 33 20 63 6c 61 75 rmal 2 or 3 clau
6010: 73 65 20 49 46 20 66 6f 72 6d 73 20 61 72 65 20 se IF forms are
6020: 73 70 65 63 69 61 6c 20 63 61 73 65 73 29 2e 0a special cases)..
6030: 0a 28 64 65 66 69 6e 65 20 28 63 2d 69 66 2f 73 .(define (c-if/s
6040: 74 6d 74 20 63 20 70 20 2e 20 72 65 73 74 29 0a tmt c p . rest).
6050: 20 20 28 6c 61 6d 62 64 61 20 28 73 74 29 0a 20 (lambda (st).
6060: 20 20 20 28 6c 65 74 20 28 28 69 6e 64 65 6e 74 (let ((indent
6070: 20 28 63 2d 63 75 72 72 65 6e 74 2d 69 6e 64 65 (c-current-inde
6080: 6e 74 2d 73 74 72 69 6e 67 20 73 74 29 29 29 0a nt-string st))).
6090: 20 20 20 20 20 20 28 28 6c 65 74 20 6c 70 20 28 ((let lp (
60a0: 28 63 20 63 29 20 28 70 20 70 29 20 28 6c 73 20 (c c) (p p) (ls
60b0: 72 65 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 rest)).
60c0: 28 69 66 20 28 6f 72 20 28 65 71 3f 20 63 20 27 (if (or (eq? c '
60d0: 65 6c 73 65 29 20 28 65 71 3f 20 63 20 23 74 29 else) (eq? c #t)
60e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
60f0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 6c if (not (null? l
6100: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
6110: 20 20 20 20 20 28 65 72 72 6f 72 20 22 66 6f 72 (error "for
6120: 6d 73 20 61 66 74 65 72 20 65 6c 73 65 20 63 6c ms after else cl
6130: 61 75 73 65 20 69 6e 20 49 46 22 20 63 20 70 20 ause in IF" c p
6140: 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ls).
6150: 20 20 20 20 20 28 63 61 74 20 28 63 2d 62 6c 6f (cat (c-blo
6160: 63 6b 2f 61 75 78 20 2d 31 20 22 20 65 6c 73 65 ck/aux -1 " else
6170: 22 20 70 29 20 66 6c 29 29 0a 20 20 20 20 20 20 " p) fl)).
6180: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 61 (let ((ta
6190: 69 6c 20 28 69 66 20 28 70 61 69 72 3f 20 6c 73 il (if (pair? ls
61a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
61b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
61c0: 69 66 20 28 70 61 69 72 3f 20 28 63 64 72 20 6c if (pair? (cdr l
61d0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
61e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61f0: 20 20 20 20 20 28 6c 70 20 28 63 61 72 20 6c 73 (lp (car ls
6200: 29 20 28 63 61 64 72 20 6c 73 29 20 28 63 64 64 ) (cadr ls) (cdd
6210: 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 r ls)).
6220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6230: 20 20 20 20 20 20 20 20 28 6c 70 20 27 65 6c 73 (lp 'els
6240: 65 20 28 63 61 72 20 6c 73 29 20 27 28 29 29 29 e (car ls) '()))
6250: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 6c fl
6270: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
6280: 20 20 20 28 63 61 74 20 28 63 2d 62 6c 6f 63 6b (cat (c-block
6290: 2f 61 75 78 0a 20 20 20 20 20 20 20 20 20 20 20 /aux.
62a0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 (if (e
62b0: 71 3f 20 6c 73 20 72 65 73 74 29 20 30 20 2d 31 q? ls rest) 0 -1
62c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
62d0: 20 20 20 20 20 20 20 28 63 61 74 20 28 69 66 20 (cat (if
62e0: 28 65 71 3f 20 6c 73 20 72 65 73 74 29 20 28 6c (eq? ls rest) (l
62f0: 61 6d 62 64 61 20 28 78 29 20 78 29 20 22 20 65 ambda (x) x) " e
6300: 6c 73 65 20 22 29 0a 20 20 20 20 20 20 20 20 20 lse ").
6310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6320: 20 22 69 66 20 28 22 20 28 63 2d 69 6e 2d 74 65 "if (" (c-in-te
6330: 73 74 20 28 63 2d 65 78 70 72 20 63 29 29 20 22 st (c-expr c)) "
6340: 29 22 29 20 70 29 0a 20 20 20 20 20 20 20 20 20 )") p).
6350: 20 20 20 20 20 20 20 20 20 20 20 74 61 69 6c 29 tail)
6360: 29 29 29 0a 20 20 20 20 20 20 20 73 74 29 29 29 ))). st)))
6370: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 69 66 )..(define (c-if
6380: 2f 65 78 70 72 20 63 20 70 20 2e 20 72 65 73 74 /expr c p . rest
6390: 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 63 20 ). (let lp ((c
63a0: 63 29 20 28 70 20 70 29 20 28 6c 73 20 72 65 73 c) (p p) (ls res
63b0: 74 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 t)). (cond.
63c0: 20 20 20 20 28 28 6f 72 20 28 65 71 3f 20 63 20 ((or (eq? c
63d0: 27 65 6c 73 65 29 20 28 65 71 3f 20 63 20 23 74 'else) (eq? c #t
63e0: 29 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 6e )). (if (n
63f0: 6f 74 20 28 6e 75 6c 6c 3f 20 6c 73 29 29 0a 20 ot (null? ls)).
6400: 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 (error
6410: 20 22 66 6f 72 6d 73 20 61 66 74 65 72 20 65 6c "forms after el
6420: 73 65 20 63 6c 61 75 73 65 20 69 6e 20 49 46 22 se clause in IF"
6430: 20 63 20 70 20 6c 73 29 0a 20 20 20 20 20 20 20 c p ls).
6440: 20 20 20 20 28 63 2d 65 78 70 72 20 70 29 29 29 (c-expr p)))
6450: 0a 20 20 20 20 20 20 28 28 70 61 69 72 3f 20 6c . ((pair? l
6460: 73 29 0a 20 20 20 20 20 20 20 28 63 61 74 20 28 s). (cat (
6470: 63 2d 69 6e 2d 74 65 73 74 20 28 63 2d 65 78 70 c-in-test (c-exp
6480: 72 20 63 29 29 20 22 20 3f 20 22 20 28 63 2d 65 r c)) " ? " (c-e
6490: 78 70 72 20 70 29 20 22 20 3a 20 22 0a 20 20 20 xpr p) " : ".
64a0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 70 61 (if (pa
64b0: 69 72 3f 20 28 63 64 72 20 6c 73 29 29 0a 20 20 ir? (cdr ls)).
64c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
64d0: 70 20 28 63 61 72 20 6c 73 29 20 28 63 61 64 72 p (car ls) (cadr
64e0: 20 6c 73 29 20 28 63 64 64 72 20 6c 73 29 29 0a ls) (cddr ls)).
64f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6500: 28 6c 70 20 27 65 6c 73 65 20 28 63 61 72 20 6c (lp 'else (car l
6510: 73 29 20 27 28 29 29 29 29 29 0a 20 20 20 20 20 s) '())))).
6520: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 28 63 (else. (c
6530: 2d 6f 72 20 28 63 2d 69 6e 2d 74 65 73 74 20 28 -or (c-in-test (
6540: 63 2d 65 78 70 72 20 63 29 29 20 28 63 2d 65 78 c-expr c)) (c-ex
6550: 70 72 20 70 29 29 29 29 29 29 0a 0a 28 64 65 66 pr p))))))..(def
6560: 69 6e 65 20 28 63 2d 69 66 20 2e 20 61 72 67 73 ine (c-if . args
6570: 29 0a 20 20 28 66 6d 74 2d 69 66 20 66 6d 74 2d ). (fmt-if fmt-
6580: 65 78 70 72 65 73 73 69 6f 6e 3f 0a 20 20 20 20 expression?.
6590: 20 20 20 20 20 20 28 61 70 70 6c 79 20 63 2d 69 (apply c-i
65a0: 66 2f 65 78 70 72 20 61 72 67 73 29 0a 20 20 20 f/expr args).
65b0: 20 20 20 20 20 20 20 28 61 70 70 6c 79 20 63 2d (apply c-
65c0: 69 66 2f 73 74 6d 74 20 61 72 67 73 29 29 29 0a if/stmt args))).
65d0: 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b .;;;;;;;;;;;;;;;
65e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
65f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
6600: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
6610: 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 73 77 69 ;;;;;;;;;.;; swi
6620: 74 63 68 20 73 74 61 74 65 6d 65 6e 74 73 2c 20 tch statements,
6630: 61 75 74 6f 6d 61 74 69 63 20 62 72 65 61 6b 20 automatic break
6640: 68 61 6e 64 6c 69 6e 67 0a 0a 28 64 65 66 69 6e handling..(defin
6650: 65 20 28 63 2d 6c 61 62 65 6c 20 6e 61 6d 65 29 e (c-label name)
6660: 0a 20 20 28 6c 61 6d 62 64 61 20 28 73 74 29 0a . (lambda (st).
6670: 20 20 20 20 28 6c 65 74 20 28 28 69 6e 64 65 6e (let ((inden
6680: 74 20 28 6d 61 6b 65 2d 73 70 61 63 65 20 28 6d t (make-space (m
6690: 61 78 20 30 20 28 2d 20 28 66 6d 74 2d 63 6f 6c ax 0 (- (fmt-col
66a0: 20 73 74 29 20 32 29 29 29 29 29 0a 20 20 20 20 st) 2))))).
66b0: 20 20 28 28 63 61 74 20 66 6c 20 69 6e 64 65 6e ((cat fl inden
66c0: 74 20 6e 61 6d 65 20 22 3a 22 20 66 6c 29 20 73 t name ":" fl) s
66d0: 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 t))))..(define c
66e0: 2d 62 72 65 61 6b 0a 20 20 28 63 2d 77 72 61 70 -break. (c-wrap
66f0: 2d 73 74 6d 74 20 28 64 73 70 20 22 62 72 65 61 -stmt (dsp "brea
6700: 6b 22 29 29 29 0a 28 64 65 66 69 6e 65 20 63 2d k"))).(define c-
6710: 63 6f 6e 74 69 6e 75 65 0a 20 20 28 63 2d 77 72 continue. (c-wr
6720: 61 70 2d 73 74 6d 74 20 28 64 73 70 20 22 63 6f ap-stmt (dsp "co
6730: 6e 74 69 6e 75 65 22 29 29 29 0a 28 64 65 66 69 ntinue"))).(defi
6740: 6e 65 20 28 63 2d 72 65 74 75 72 6e 20 2e 20 72 ne (c-return . r
6750: 65 73 75 6c 74 29 0a 20 20 28 69 66 20 28 70 61 esult). (if (pa
6760: 69 72 3f 20 72 65 73 75 6c 74 29 0a 20 20 20 20 ir? result).
6770: 20 20 28 63 2d 77 72 61 70 2d 73 74 6d 74 20 28 (c-wrap-stmt (
6780: 63 61 74 20 22 72 65 74 75 72 6e 20 22 20 28 63 cat "return " (c
6790: 2d 65 78 70 72 20 28 63 61 72 20 72 65 73 75 6c -expr (car resul
67a0: 74 29 29 29 29 0a 20 20 20 20 20 20 28 63 2d 77 t)))). (c-w
67b0: 72 61 70 2d 73 74 6d 74 20 28 64 73 70 20 22 72 rap-stmt (dsp "r
67c0: 65 74 75 72 6e 22 29 29 29 29 0a 28 64 65 66 69 eturn")))).(defi
67d0: 6e 65 20 28 63 2d 67 6f 74 6f 20 6c 61 62 65 6c ne (c-goto label
67e0: 29 0a 20 20 28 63 2d 77 72 61 70 2d 73 74 6d 74 ). (c-wrap-stmt
67f0: 20 28 63 61 74 20 22 67 6f 74 6f 20 22 20 28 63 (cat "goto " (c
6800: 2d 65 78 70 72 20 6c 61 62 65 6c 29 29 29 29 0a -expr label)))).
6810: 0a 28 64 65 66 69 6e 65 20 28 63 2d 73 77 69 74 .(define (c-swit
6820: 63 68 20 76 61 6c 20 2e 20 63 6c 61 75 73 65 73 ch val . clauses
6830: 29 0a 20 20 28 6c 61 6d 62 64 61 20 28 73 74 29 ). (lambda (st)
6840: 0a 20 20 20 20 28 28 63 61 74 20 22 73 77 69 74 . ((cat "swit
6850: 63 68 20 28 22 20 28 63 2d 69 6e 2d 65 78 70 72 ch (" (c-in-expr
6860: 20 76 61 6c 29 20 22 29 22 20 28 63 2d 6f 70 65 val) ")" (c-ope
6870: 6e 2d 62 72 61 63 65 20 73 74 29 0a 20 20 20 20 n-brace st).
6880: 20 20 20 20 20 20 28 63 2d 69 6e 64 65 6e 74 2f (c-indent/
6890: 73 77 69 74 63 68 20 73 74 29 0a 20 20 20 20 20 switch st).
68a0: 20 20 20 20 20 28 63 2d 69 6e 2d 73 74 6d 74 20 (c-in-stmt
68b0: 28 61 70 70 6c 79 20 63 2d 62 65 67 69 6e 2f 61 (apply c-begin/a
68c0: 75 78 20 23 74 20 28 6d 61 70 20 63 2d 73 77 69 ux #t (map c-swi
68d0: 74 63 68 2d 63 6c 61 75 73 65 20 63 6c 61 75 73 tch-clause claus
68e0: 65 73 29 29 29 20 66 6c 0a 20 20 20 20 20 20 20 es))) fl.
68f0: 20 20 20 28 63 2d 63 75 72 72 65 6e 74 2d 69 6e (c-current-in
6900: 64 65 6e 74 2d 73 74 72 69 6e 67 20 73 74 29 20 dent-string st)
6910: 28 63 2d 63 6c 6f 73 65 2d 62 72 61 63 65 20 73 (c-close-brace s
6920: 74 29 20 66 6c 29 0a 20 20 20 20 20 73 74 29 29 t) fl). st))
6930: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 73 77 )..(define (c-sw
6940: 69 74 63 68 2d 63 6c 61 75 73 65 2f 62 72 65 61 itch-clause/brea
6950: 6b 73 20 78 29 0a 20 20 28 6c 61 6d 62 64 61 20 ks x). (lambda
6960: 28 73 74 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 (st). (let* (
6970: 28 62 72 65 61 6b 3f 0a 20 20 20 20 20 20 20 20 (break?.
6980: 20 20 20 20 28 61 6e 64 20 28 63 61 72 20 78 29 (and (car x)
6990: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
69a0: 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 28 (not (member (
69b0: 63 61 64 72 20 78 29 20 27 28 63 61 73 65 2f 66 cadr x) '(case/f
69c0: 61 6c 6c 74 68 72 6f 75 67 68 0a 20 20 20 20 20 allthrough.
69d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69f0: 20 20 20 20 64 65 66 61 75 6c 74 2f 66 61 6c 6c default/fall
6a00: 74 68 72 6f 75 67 68 0a 20 20 20 20 20 20 20 20 through.
6a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a30: 20 65 6c 73 65 2f 66 61 6c 6c 74 68 72 6f 75 67 else/fallthroug
6a40: 68 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 h))))).
6a50: 20 20 28 65 78 70 6c 69 63 69 74 2d 63 61 73 65 (explicit-case
6a60: 3f 20 28 6d 65 6d 62 65 72 20 28 63 61 64 72 20 ? (member (cadr
6a70: 78 29 20 27 28 63 61 73 65 20 63 61 73 65 2f 66 x) '(case case/f
6a80: 61 6c 6c 74 68 72 6f 75 67 68 29 29 29 0a 20 20 allthrough))).
6a90: 20 20 20 20 20 20 20 20 20 28 69 6e 64 65 6e 74 (indent
6aa0: 20 28 63 2d 63 75 72 72 65 6e 74 2d 69 6e 64 65 (c-current-inde
6ab0: 6e 74 2d 73 74 72 69 6e 67 20 73 74 29 29 0a 20 nt-string st)).
6ac0: 20 20 20 20 20 20 20 20 20 20 28 69 6e 64 65 6e (inden
6ad0: 74 2d 62 6f 64 79 20 28 63 2d 69 6e 64 65 6e 74 t-body (c-indent
6ae0: 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 st)).
6af0: 20 28 73 65 70 20 28 73 74 72 69 6e 67 2d 61 70 (sep (string-ap
6b00: 70 65 6e 64 20 22 3a 22 20 6e 6c 2d 73 74 72 20 pend ":" nl-str
6b10: 69 6e 64 65 6e 74 29 29 29 0a 20 20 20 20 20 20 indent))).
6b20: 28 28 63 61 74 20 28 63 2d 69 6e 2d 65 78 70 72 ((cat (c-in-expr
6b30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 . (f
6b40: 6d 74 2d 6a 6f 69 6e 2f 73 75 66 66 69 78 0a 20 mt-join/suffix.
6b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 64 73 70 dsp
6b60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
6b70: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
6b80: 20 20 20 20 28 28 70 61 69 72 3f 20 28 63 61 64 ((pair? (cad
6b90: 72 20 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 r x)).
6ba0: 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 (map (lamb
6bb0: 64 61 20 28 79 29 20 28 63 61 74 20 28 64 73 70 da (y) (cat (dsp
6bc0: 20 22 63 61 73 65 20 22 29 20 28 63 2d 65 78 70 "case ") (c-exp
6bd0: 72 20 79 29 29 29 0a 20 20 20 20 20 20 20 20 20 r y))).
6be0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 64 (cad
6bf0: 72 20 78 29 29 29 0a 20 20 20 20 20 20 20 20 20 r x))).
6c00: 20 20 20 20 20 20 28 65 78 70 6c 69 63 69 74 2d (explicit-
6c10: 63 61 73 65 3f 0a 20 20 20 20 20 20 20 20 20 20 case?.
6c20: 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 (map (lamb
6c30: 64 61 20 28 79 29 20 28 63 61 74 20 28 64 73 70 da (y) (cat (dsp
6c40: 20 22 63 61 73 65 20 22 29 20 28 63 2d 65 78 70 "case ") (c-exp
6c50: 72 20 79 29 29 29 0a 20 20 20 20 20 20 20 20 20 r y))).
6c60: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
6c70: 28 6c 69 73 74 3f 20 28 63 61 64 64 72 20 78 29 (list? (caddr x)
6c80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6c90: 20 20 20 20 20 20 20 20 20 20 20 28 63 61 64 64 (cadd
6ca0: 72 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 r x).
6cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
6cc0: 69 73 74 20 28 63 61 64 64 72 20 78 29 29 29 29 ist (caddr x))))
6cd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6ce0: 20 28 28 6d 65 6d 62 65 72 20 28 63 61 64 72 20 ((member (cadr
6cf0: 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x).
6d00: 20 20 20 20 20 20 20 20 20 20 20 27 28 64 65 66 '(def
6d10: 61 75 6c 74 20 65 6c 73 65 20 64 65 66 61 75 6c ault else defaul
6d20: 74 2f 66 61 6c 6c 74 68 72 6f 75 67 68 20 65 6c t/fallthrough el
6d30: 73 65 2f 66 61 6c 6c 74 68 72 6f 75 67 68 29 29 se/fallthrough))
6d40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6d50: 20 28 6c 69 73 74 20 28 64 73 70 20 22 64 65 66 (list (dsp "def
6d60: 61 75 6c 74 22 29 29 29 0a 20 20 20 20 20 20 20 ault"))).
6d70: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
6d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
6d90: 72 72 6f 72 0a 20 20 20 20 20 20 20 20 20 20 20 rror.
6da0: 20 20 20 20 20 20 22 75 6e 6b 6e 6f 77 6e 20 73 "unknown s
6db0: 77 69 74 63 68 20 63 6c 61 75 73 65 2c 20 65 78 witch clause, ex
6dc0: 70 65 63 74 65 64 20 61 20 6c 69 73 74 20 6f 72 pected a list or
6dd0: 20 64 65 66 61 75 6c 74 20 62 75 74 20 67 6f 74 default but got
6de0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
6df0: 20 20 20 28 63 61 64 72 20 78 29 29 29 29 0a 20 (cadr x)))).
6e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 70 sep
6e10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
6e20: 6d 61 6b 65 2d 73 70 61 63 65 20 28 6f 72 20 28 make-space (or (
6e30: 66 6d 74 2d 69 6e 64 65 6e 74 2d 73 70 61 63 65 fmt-indent-space
6e40: 20 73 74 29 20 34 29 29 0a 20 20 20 20 20 20 20 st) 4)).
6e50: 20 20 20 20 20 28 66 6d 74 2d 6a 6f 69 6e 20 63 (fmt-join c
6e60: 2d 65 78 70 72 0a 20 20 20 20 20 20 20 20 20 20 -expr.
6e70: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
6e80: 65 78 70 6c 69 63 69 74 2d 63 61 73 65 3f 20 28 explicit-case? (
6e90: 63 64 64 64 72 20 78 29 20 28 63 64 64 72 20 78 cdddr x) (cddr x
6ea0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6eb0: 20 20 20 20 20 20 20 20 20 69 6e 64 65 6e 74 2d indent-
6ec0: 62 6f 64 79 29 0a 20 20 20 20 20 20 20 20 20 20 body).
6ed0: 20 20 28 69 66 20 28 61 6e 64 20 62 72 65 61 6b (if (and break
6ee0: 3f 20 28 6e 6f 74 20 28 66 6d 74 2d 72 65 74 75 ? (not (fmt-retu
6ef0: 72 6e 3f 20 73 74 29 29 29 0a 20 20 20 20 20 20 rn? st))).
6f00: 20 20 20 20 20 20 20 20 20 20 28 63 61 74 20 66 (cat f
6f10: 6c 20 69 6e 64 65 6e 74 2d 62 6f 64 79 20 63 2d l indent-body c-
6f20: 62 72 65 61 6b 29 0a 20 20 20 20 20 20 20 20 20 break).
6f30: 20 20 20 20 20 20 20 22 22 29 29 0a 20 20 20 20 "")).
6f40: 20 20 20 73 74 29 29 29 29 0a 0a 28 64 65 66 69 st))))..(defi
6f50: 6e 65 20 28 63 2d 73 77 69 74 63 68 2d 63 6c 61 ne (c-switch-cla
6f60: 75 73 65 20 78 29 0a 20 20 28 69 66 20 28 70 72 use x). (if (pr
6f70: 6f 63 65 64 75 72 65 3f 20 78 29 20 78 20 28 63 ocedure? x) x (c
6f80: 2d 73 77 69 74 63 68 2d 63 6c 61 75 73 65 2f 62 -switch-clause/b
6f90: 72 65 61 6b 73 20 28 63 6f 6e 73 20 23 74 20 78 reaks (cons #t x
6fa0: 29 29 29 29 0a 28 64 65 66 69 6e 65 20 28 63 2d )))).(define (c-
6fb0: 73 77 69 74 63 68 2d 63 6c 61 75 73 65 2f 6e 6f switch-clause/no
6fc0: 2d 62 72 65 61 6b 20 78 29 0a 20 20 28 69 66 20 -break x). (if
6fd0: 28 70 72 6f 63 65 64 75 72 65 3f 20 78 29 20 78 (procedure? x) x
6fe0: 20 28 63 2d 73 77 69 74 63 68 2d 63 6c 61 75 73 (c-switch-claus
6ff0: 65 2f 62 72 65 61 6b 73 20 28 63 6f 6e 73 20 23 e/breaks (cons #
7000: 66 20 78 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 f x))))..(define
7010: 20 28 63 2d 63 61 73 65 20 78 20 2e 20 62 6f 64 (c-case x . bod
7020: 79 29 0a 20 20 28 63 2d 73 77 69 74 63 68 2d 63 y). (c-switch-c
7030: 6c 61 75 73 65 20 28 63 6f 6e 73 20 28 69 66 20 lause (cons (if
7040: 28 70 61 69 72 3f 20 78 29 20 78 20 28 6c 69 73 (pair? x) x (lis
7050: 74 20 78 29 29 20 62 6f 64 79 29 29 29 0a 28 64 t x)) body))).(d
7060: 65 66 69 6e 65 20 28 63 2d 63 61 73 65 2f 66 61 efine (c-case/fa
7070: 6c 6c 74 68 72 6f 75 67 68 20 78 20 2e 20 62 6f llthrough x . bo
7080: 64 79 29 0a 20 20 28 63 2d 73 77 69 74 63 68 2d dy). (c-switch-
7090: 63 6c 61 75 73 65 2f 6e 6f 2d 62 72 65 61 6b 20 clause/no-break
70a0: 28 63 6f 6e 73 20 28 69 66 20 28 70 61 69 72 3f (cons (if (pair?
70b0: 20 78 29 20 78 20 28 6c 69 73 74 20 78 29 29 20 x) x (list x))
70c0: 62 6f 64 79 29 29 29 0a 28 64 65 66 69 6e 65 20 body))).(define
70d0: 28 63 2d 64 65 66 61 75 6c 74 20 2e 20 62 6f 64 (c-default . bod
70e0: 79 29 0a 20 20 28 63 2d 73 77 69 74 63 68 2d 63 y). (c-switch-c
70f0: 6c 61 75 73 65 2f 62 72 65 61 6b 73 20 28 63 6f lause/breaks (co
7100: 6e 73 20 23 74 20 28 63 6f 6e 73 20 27 65 6c 73 ns #t (cons 'els
7110: 65 20 62 6f 64 79 29 29 29 29 0a 0a 3b 3b 3b 3b e body))))..;;;;
7120: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
7130: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
7140: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
7150: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
7160: 3b 3b 3b 3b 0a 3b 3b 20 6f 70 65 72 61 74 6f 72 ;;;;.;; operator
7170: 73 0a 0a 28 64 65 66 69 6e 65 20 28 63 2d 6f 70 s..(define (c-op
7180: 20 6f 70 20 66 69 72 73 74 20 2e 20 72 65 73 74 op first . rest
7190: 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 ). (if (null? r
71a0: 65 73 74 29 0a 20 20 20 20 20 20 28 63 2d 75 6e est). (c-un
71b0: 61 72 79 2d 6f 70 20 6f 70 20 66 69 72 73 74 29 ary-op op first)
71c0: 0a 20 20 20 20 20 20 28 61 70 70 6c 79 20 63 2d . (apply c-
71d0: 62 69 6e 61 72 79 2d 6f 70 20 6f 70 20 66 69 72 binary-op op fir
71e0: 73 74 20 72 65 73 74 29 29 29 0a 0a 28 64 65 66 st rest)))..(def
71f0: 69 6e 65 20 28 63 2d 62 69 6e 61 72 79 2d 6f 70 ine (c-binary-op
7200: 20 6f 70 20 2e 20 6c 73 29 0a 20 20 28 64 65 66 op . ls). (def
7210: 69 6e 65 20 28 6c 69 74 2d 6f 70 3f 20 78 29 20 ine (lit-op? x)
7220: 28 6f 72 20 28 63 2d 6c 69 74 65 72 61 6c 3f 20 (or (c-literal?
7230: 78 29 20 28 73 79 6d 62 6f 6c 3f 20 78 29 29 29 x) (symbol? x)))
7240: 0a 20 20 28 6c 65 74 20 28 28 73 74 72 20 28 64 . (let ((str (d
7250: 69 73 70 6c 61 79 2d 74 6f 2d 73 74 72 69 6e 67 isplay-to-string
7260: 20 6f 70 29 29 29 0a 20 20 20 20 28 63 2d 77 72 op))). (c-wr
7270: 61 70 2d 73 74 6d 74 0a 20 20 20 20 20 28 63 2d ap-stmt. (c-
7280: 6d 61 79 62 65 2d 70 61 72 65 6e 0a 20 20 20 20 maybe-paren.
7290: 20 20 6f 70 0a 20 20 20 20 20 20 28 69 66 20 28 op. (if (
72a0: 6f 72 20 28 65 71 75 61 6c 3f 20 73 74 72 20 22 or (equal? str "
72b0: 2e 22 29 20 28 65 71 75 61 6c 3f 20 73 74 72 20 .") (equal? str
72c0: 22 2d 3e 22 29 29 0a 20 20 20 20 20 20 20 20 20 "->")).
72d0: 20 28 66 6d 74 2d 6a 6f 69 6e 20 63 2d 65 78 70 (fmt-join c-exp
72e0: 72 20 6c 73 20 73 74 72 29 0a 20 20 20 20 20 20 r ls str).
72f0: 20 20 20 20 28 6c 65 74 20 28 28 66 6c 61 74 0a (let ((flat.
7300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7310: 20 28 66 6d 74 2d 6c 65 74 20 27 6e 6f 2d 77 72 (fmt-let 'no-wr
7320: 61 70 3f 20 23 74 0a 20 20 20 20 20 20 20 20 20 ap? #t.
7330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7340: 20 28 6c 61 6d 62 64 61 20 28 73 74 29 0a 20 20 (lambda (st).
7350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7360: 20 20 20 20 20 20 20 20 20 20 28 28 66 6d 74 2d ((fmt-
7370: 6a 6f 69 6e 20 63 2d 65 78 70 72 0a 20 20 20 20 join c-expr.
7380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73a0: 20 20 20 6c 73 0a 20 20 20 20 20 20 20 20 20 20 ls.
73b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
73d0: 20 28 61 6e 64 20 28 66 6d 74 2d 6e 6f 6e 2d 73 (and (fmt-non-s
73e0: 70 61 63 65 64 2d 6f 70 73 3f 20 73 74 29 0a 20 paced-ops? st).
73f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
7420: 65 76 65 72 79 20 6c 69 74 2d 6f 70 3f 20 6c 73 every lit-op? ls
7430: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
7440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
7460: 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
7470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7480: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
7490: 72 69 6e 67 2d 61 70 70 65 6e 64 20 22 20 22 20 ring-append " "
74a0: 73 74 72 20 22 20 22 29 29 29 0a 20 20 20 20 20 str " "))).
74b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
74c0: 20 20 20 20 20 20 20 20 73 74 29 29 29 29 29 0a st))))).
74d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6d 74 (fmt
74e0: 2d 69 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 -if.
74f0: 20 66 6d 74 2d 6e 6f 2d 77 72 61 70 3f 0a 20 20 fmt-no-wrap?.
7500: 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 74 0a flat.
7510: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6d (fm
7520: 74 2d 74 72 79 2d 66 69 74 0a 20 20 20 20 20 20 t-try-fit.
7530: 20 20 20 20 20 20 20 20 66 6c 61 74 0a 20 20 20 flat.
7540: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
7550: 64 61 20 28 73 74 29 0a 20 20 20 20 20 20 20 20 da (st).
7560: 20 20 20 20 20 20 20 20 20 20 20 28 28 66 6d 74 ((fmt
7570: 2d 6a 6f 69 6e 20 63 2d 65 78 70 72 0a 20 20 20 -join c-expr.
7580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7590: 20 20 20 20 20 20 20 20 20 20 20 6c 73 0a 20 20 ls.
75a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 74 (cat
75c0: 20 6e 6c 20 28 6d 61 6b 65 2d 73 70 61 63 65 20 nl (make-space
75d0: 28 2b 20 32 20 28 66 6d 74 2d 63 6f 6c 20 73 74 (+ 2 (fmt-col st
75e0: 29 29 29 20 73 74 72 20 22 20 22 29 29 0a 20 20 ))) str " ")).
75f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7600: 20 20 73 74 29 29 29 29 29 29 29 29 29 29 0a 0a st))))))))))..
7610: 28 64 65 66 69 6e 65 20 28 63 2d 75 6e 61 72 79 (define (c-unary
7620: 2d 6f 70 20 6f 70 20 78 29 0a 20 20 28 63 2d 77 -op op x). (c-w
7630: 72 61 70 2d 73 74 6d 74 0a 20 20 20 28 63 61 74 rap-stmt. (cat
7640: 20 28 64 69 73 70 6c 61 79 2d 74 6f 2d 73 74 72 (display-to-str
7650: 69 6e 67 20 6f 70 29 20 28 63 2d 6d 61 79 62 65 ing op) (c-maybe
7660: 2d 70 61 72 65 6e 20 6f 70 20 28 63 2d 65 78 70 -paren op (c-exp
7670: 72 20 78 29 29 29 29 29 0a 0a 3b 3b 20 73 6f 6d r x)))))..;; som
7680: 65 20 63 6f 6e 76 65 6e 69 65 6e 63 65 20 64 65 e convenience de
7690: 66 69 6e 69 74 69 6f 6e 73 0a 0a 28 64 65 66 69 finitions..(defi
76a0: 6e 65 20 28 63 2b 2b 20 2e 20 61 72 67 73 29 20 ne (c++ . args)
76b0: 28 61 70 70 6c 79 20 63 2d 6f 70 20 22 2b 2b 22 (apply c-op "++"
76c0: 20 61 72 67 73 29 29 0a 28 64 65 66 69 6e 65 20 args)).(define
76d0: 28 63 2d 2d 20 2e 20 61 72 67 73 29 20 28 61 70 (c-- . args) (ap
76e0: 70 6c 79 20 63 2d 6f 70 20 22 2d 2d 22 20 61 72 ply c-op "--" ar
76f0: 67 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 2b gs)).(define (c+
7700: 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c 79 20 . args) (apply
7710: 63 2d 6f 70 20 27 2b 20 61 72 67 73 29 29 0a 28 c-op '+ args)).(
7720: 64 65 66 69 6e 65 20 28 63 2d 20 2e 20 61 72 67 define (c- . arg
7730: 73 29 20 28 61 70 70 6c 79 20 63 2d 6f 70 20 27 s) (apply c-op '
7740: 2d 20 61 72 67 73 29 29 0a 28 64 65 66 69 6e 65 - args)).(define
7750: 20 28 63 2a 20 2e 20 61 72 67 73 29 20 28 61 70 (c* . args) (ap
7760: 70 6c 79 20 63 2d 6f 70 20 27 2a 20 61 72 67 73 ply c-op '* args
7770: 29 29 0a 28 64 65 66 69 6e 65 20 28 63 2f 20 2e )).(define (c/ .
7780: 20 61 72 67 73 29 20 28 61 70 70 6c 79 20 63 2d args) (apply c-
7790: 6f 70 20 27 2f 20 61 72 67 73 29 29 0a 28 64 65 op '/ args)).(de
77a0: 66 69 6e 65 20 28 63 25 20 2e 20 61 72 67 73 29 fine (c% . args)
77b0: 20 28 61 70 70 6c 79 20 63 2d 6f 70 20 27 25 20 (apply c-op '%
77c0: 61 72 67 73 29 29 0a 28 64 65 66 69 6e 65 20 28 args)).(define (
77d0: 63 26 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c c& . args) (appl
77e0: 79 20 63 2d 6f 70 20 27 26 20 61 72 67 73 29 29 y c-op '& args))
77f0: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 7c 63 5c .;; (define (|c\
7800: 7c 7c 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c || . args) (appl
7810: 79 20 63 2d 6f 70 20 27 7c 5c 7c 7c 20 61 72 67 y c-op '|\|| arg
7820: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 5e 20 s)).(define (c^
7830: 2e 20 61 72 67 73 29 20 28 61 70 70 6c 79 20 63 . args) (apply c
7840: 2d 6f 70 20 27 5e 20 61 72 67 73 29 29 0a 28 64 -op '^ args)).(d
7850: 65 66 69 6e 65 20 28 63 7e 20 2e 20 61 72 67 73 efine (c~ . args
7860: 29 20 28 61 70 70 6c 79 20 63 2d 6f 70 20 27 7e ) (apply c-op '~
7870: 20 61 72 67 73 29 29 0a 28 64 65 66 69 6e 65 20 args)).(define
7880: 28 63 21 20 2e 20 61 72 67 73 29 20 28 61 70 70 (c! . args) (app
7890: 6c 79 20 63 2d 6f 70 20 27 21 20 61 72 67 73 29 ly c-op '! args)
78a0: 29 0a 28 64 65 66 69 6e 65 20 28 63 26 26 20 2e ).(define (c&& .
78b0: 20 61 72 67 73 29 20 28 61 70 70 6c 79 20 63 2d args) (apply c-
78c0: 6f 70 20 27 26 26 20 61 72 67 73 29 29 0a 3b 3b op '&& args)).;;
78d0: 20 28 64 65 66 69 6e 65 20 28 7c 63 5c 7c 5c 7c (define (|c\|\|
78e0: 7c 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c 79 | . args) (apply
78f0: 20 63 2d 6f 70 20 27 7c 5c 7c 5c 7c 7c 20 61 72 c-op '|\|\|| ar
7900: 67 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 3c gs)).(define (c<
7910: 3c 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c 79 < . args) (apply
7920: 20 63 2d 6f 70 20 27 3c 3c 20 61 72 67 73 29 29 c-op '<< args))
7930: 0a 28 64 65 66 69 6e 65 20 28 63 3e 3e 20 2e 20 .(define (c>> .
7940: 61 72 67 73 29 20 28 61 70 70 6c 79 20 63 2d 6f args) (apply c-o
7950: 70 20 27 3e 3e 20 61 72 67 73 29 29 0a 28 64 65 p '>> args)).(de
7960: 66 69 6e 65 20 28 63 3d 3d 20 2e 20 61 72 67 73 fine (c== . args
7970: 29 20 28 61 70 70 6c 79 20 63 2d 6f 70 20 27 3d ) (apply c-op '=
7980: 3d 20 61 72 67 73 29 29 0a 28 64 65 66 69 6e 65 = args)).(define
7990: 20 28 63 21 3d 20 2e 20 61 72 67 73 29 20 28 61 (c!= . args) (a
79a0: 70 70 6c 79 20 63 2d 6f 70 20 27 21 3d 20 61 72 pply c-op '!= ar
79b0: 67 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 3c gs)).(define (c<
79c0: 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c 79 20 . args) (apply
79d0: 63 2d 6f 70 20 27 3c 20 61 72 67 73 29 29 0a 28 c-op '< args)).(
79e0: 64 65 66 69 6e 65 20 28 63 3e 20 2e 20 61 72 67 define (c> . arg
79f0: 73 29 20 28 61 70 70 6c 79 20 63 2d 6f 70 20 27 s) (apply c-op '
7a00: 3e 20 61 72 67 73 29 29 0a 28 64 65 66 69 6e 65 > args)).(define
7a10: 20 28 63 3c 3d 20 2e 20 61 72 67 73 29 20 28 61 (c<= . args) (a
7a20: 70 70 6c 79 20 63 2d 6f 70 20 27 3c 3d 20 61 72 pply c-op '<= ar
7a30: 67 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 3e gs)).(define (c>
7a40: 3d 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c 79 = . args) (apply
7a50: 20 63 2d 6f 70 20 27 3e 3d 20 61 72 67 73 29 29 c-op '>= args))
7a60: 0a 28 64 65 66 69 6e 65 20 28 63 3d 20 2e 20 61 .(define (c= . a
7a70: 72 67 73 29 20 28 61 70 70 6c 79 20 63 2d 6f 70 rgs) (apply c-op
7a80: 20 27 3d 20 61 72 67 73 29 29 0a 28 64 65 66 69 '= args)).(defi
7a90: 6e 65 20 28 63 2b 3d 20 2e 20 61 72 67 73 29 20 ne (c+= . args)
7aa0: 28 61 70 70 6c 79 20 63 2d 6f 70 20 22 2b 3d 22 (apply c-op "+="
7ab0: 20 61 72 67 73 29 29 0a 28 64 65 66 69 6e 65 20 args)).(define
7ac0: 28 63 2d 3d 20 2e 20 61 72 67 73 29 20 28 61 70 (c-= . args) (ap
7ad0: 70 6c 79 20 63 2d 6f 70 20 22 2d 3d 22 20 61 72 ply c-op "-=" ar
7ae0: 67 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 2a gs)).(define (c*
7af0: 3d 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c 79 = . args) (apply
7b00: 20 63 2d 6f 70 20 27 2a 3d 20 61 72 67 73 29 29 c-op '*= args))
7b10: 0a 28 64 65 66 69 6e 65 20 28 63 2f 3d 20 2e 20 .(define (c/= .
7b20: 61 72 67 73 29 20 28 61 70 70 6c 79 20 63 2d 6f args) (apply c-o
7b30: 70 20 27 2f 3d 20 61 72 67 73 29 29 0a 28 64 65 p '/= args)).(de
7b40: 66 69 6e 65 20 28 63 25 3d 20 2e 20 61 72 67 73 fine (c%= . args
7b50: 29 20 28 61 70 70 6c 79 20 63 2d 6f 70 20 27 25 ) (apply c-op '%
7b60: 3d 20 61 72 67 73 29 29 0a 28 64 65 66 69 6e 65 = args)).(define
7b70: 20 28 63 26 3d 20 2e 20 61 72 67 73 29 20 28 61 (c&= . args) (a
7b80: 70 70 6c 79 20 63 2d 6f 70 20 27 26 3d 20 61 72 pply c-op '&= ar
7b90: 67 73 29 29 0a 3b 3b 20 28 64 65 66 69 6e 65 20 gs)).;; (define
7ba0: 28 7c 63 5c 7c 3d 7c 20 2e 20 61 72 67 73 29 20 (|c\|=| . args)
7bb0: 28 61 70 70 6c 79 20 63 2d 6f 70 20 27 7c 5c 7c (apply c-op '|\|
7bc0: 3d 7c 20 61 72 67 73 29 29 0a 28 64 65 66 69 6e =| args)).(defin
7bd0: 65 20 28 63 5e 3d 20 2e 20 61 72 67 73 29 20 28 e (c^= . args) (
7be0: 61 70 70 6c 79 20 63 2d 6f 70 20 27 5e 3d 20 61 apply c-op '^= a
7bf0: 72 67 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 rgs)).(define (c
7c00: 3c 3c 3d 20 2e 20 61 72 67 73 29 20 28 61 70 70 <<= . args) (app
7c10: 6c 79 20 63 2d 6f 70 20 27 3c 3c 3d 20 61 72 67 ly c-op '<<= arg
7c20: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 63 3e 3e s)).(define (c>>
7c30: 3d 20 2e 20 61 72 67 73 29 20 28 61 70 70 6c 79 = . args) (apply
7c40: 20 63 2d 6f 70 20 27 3e 3e 3d 20 61 72 67 73 29 c-op '>>= args)
7c50: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 2e 20 2e )..(define (c. .
7c60: 20 61 72 67 73 29 20 28 61 70 70 6c 79 20 63 2d args) (apply c-
7c70: 6f 70 20 22 2e 22 20 61 72 67 73 29 29 0a 28 64 op "." args)).(d
7c80: 65 66 69 6e 65 20 28 63 2d 3e 20 2e 20 61 72 67 efine (c-> . arg
7c90: 73 29 20 28 61 70 70 6c 79 20 63 2d 6f 70 20 22 s) (apply c-op "
7ca0: 2d 3e 22 20 61 72 67 73 29 29 0a 0a 28 64 65 66 ->" args))..(def
7cb0: 69 6e 65 20 28 63 2d 62 69 74 2d 6f 72 20 2e 20 ine (c-bit-or .
7cc0: 61 72 67 73 29 20 28 61 70 70 6c 79 20 63 2d 6f args) (apply c-o
7cd0: 70 20 22 7c 22 20 61 72 67 73 29 29 0a 28 64 65 p "|" args)).(de
7ce0: 66 69 6e 65 20 28 63 2d 6f 72 20 2e 20 61 72 67 fine (c-or . arg
7cf0: 73 29 20 28 61 70 70 6c 79 20 63 2d 6f 70 20 22 s) (apply c-op "
7d00: 7c 7c 22 20 61 72 67 73 29 29 0a 28 64 65 66 69 ||" args)).(defi
7d10: 6e 65 20 28 63 2d 62 69 74 2d 6f 72 3d 20 2e 20 ne (c-bit-or= .
7d20: 61 72 67 73 29 20 28 61 70 70 6c 79 20 63 2d 6f args) (apply c-o
7d30: 70 20 22 7c 3d 22 20 61 72 67 73 29 29 0a 0a 28 p "|=" args))..(
7d40: 64 65 66 69 6e 65 20 28 63 2b 2b 2f 70 6f 73 74 define (c++/post
7d50: 20 78 29 0a 20 20 28 63 61 74 20 28 63 2d 6d 61 x). (cat (c-ma
7d60: 79 62 65 2d 70 61 72 65 6e 20 27 70 6f 73 74 2d ybe-paren 'post-
7d70: 69 6e 63 72 65 6d 65 6e 74 20 28 63 2d 65 78 70 increment (c-exp
7d80: 72 20 78 29 29 20 22 2b 2b 22 29 29 0a 28 64 65 r x)) "++")).(de
7d90: 66 69 6e 65 20 28 63 2d 2d 2f 70 6f 73 74 20 78 fine (c--/post x
7da0: 29 0a 20 20 28 63 61 74 20 28 63 2d 6d 61 79 62 ). (cat (c-mayb
7db0: 65 2d 70 61 72 65 6e 20 27 70 6f 73 74 2d 64 65 e-paren 'post-de
7dc0: 63 72 65 6d 65 6e 74 20 28 63 2d 65 78 70 72 20 crement (c-expr
7dd0: 78 29 29 20 22 2d 2d 22 29 29 0a 0a x)) "--"))..