Artifact 225fe1c9c643acde417036075f52c16cb8322d23:
- File sdl2/ffi.ss — part of check-in [c9770d8f7f] at 2016-08-17 07:47:19 on branch trunk — added sdl2 (user: ovenpasta@pizzahack.eu size: 4209)
0000: 09 0a 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 .. (define-synta 0010: 78 20 64 65 66 69 6e 65 2d 66 74 79 70 65 2d 61 x define-ftype-a 0020: 6c 6c 6f 63 61 74 6f 72 20 0a 20 20 20 28 6c 61 llocator . (la 0030: 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 28 73 mbda (x). (s 0040: 79 6e 74 61 78 2d 63 61 73 65 20 78 20 28 29 20 yntax-case x () 0050: 0a 20 20 20 20 20 20 20 5b 28 5f 20 6e 61 6d 65 . [(_ name 0060: 20 74 79 70 65 29 20 0a 09 23 27 28 64 65 66 69 type) ..#'(defi 0070: 6e 65 20 28 6e 61 6d 65 29 20 0a 09 20 20 20 20 ne (name) .. 0080: 28 73 64 6c 2d 67 75 61 72 64 2d 70 6f 69 6e 74 (sdl-guard-point 0090: 65 72 20 28 6d 61 6b 65 2d 66 74 79 70 65 2d 70 er (make-ftype-p 00a0: 6f 69 6e 74 65 72 20 74 79 70 65 20 28 66 6f 72 ointer type (for 00b0: 65 69 67 6e 2d 61 6c 6c 6f 63 20 28 66 74 79 70 eign-alloc (ftyp 00c0: 65 2d 73 69 7a 65 6f 66 20 74 79 70 65 29 29 29 e-sizeof type))) 00d0: 29 29 5d 29 29 29 0a 0a 20 28 64 65 66 69 6e 65 ))]))).. (define 00e0: 2d 73 79 6e 74 61 78 20 64 65 66 69 6e 65 2d 73 -syntax define-s 00f0: 64 6c 2d 66 75 6e 63 0a 20 20 20 28 6c 61 6d 62 dl-func. (lamb 0100: 64 61 20 28 78 29 0a 20 20 20 20 20 28 64 65 66 da (x). (def 0110: 69 6e 65 20 28 61 6e 74 69 2d 63 61 6d 65 6c 20 ine (anti-camel 0120: 78 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 x). (let* 0130: 28 5b 78 20 28 73 74 72 69 6e 67 2d 72 65 70 6c ([x (string-repl 0140: 61 63 65 20 78 20 23 5c 5f 20 23 5c 2d 29 5d 0a ace x #\_ #\-)]. 0150: 09 20 20 20 20 20 20 5b 6c 65 6e 20 28 73 74 72 . [len (str 0160: 69 6e 67 2d 6c 65 6e 67 74 68 20 78 29 5d 0a 09 ing-length x)].. 0170: 20 20 20 20 20 20 5b 73 20 28 6c 69 73 74 2d 3e [s (list-> 0180: 73 74 72 69 6e 67 0a 09 09 20 20 28 72 65 76 65 string... (reve 0190: 72 73 65 0a 09 09 20 20 20 28 66 6f 6c 64 20 28 rse... (fold ( 01a0: 6c 61 6d 62 64 61 20 28 69 20 61 63 63 29 20 0a lambda (i acc) . 01b0: 09 09 09 20 20 20 28 6c 65 74 20 28 5b 61 20 28 ... (let ([a ( 01c0: 73 74 72 69 6e 67 2d 72 65 66 20 78 20 69 29 5d string-ref x i)] 01d0: 20 0a 09 09 09 09 20 5b 62 20 28 69 66 20 28 3c ..... [b (if (< 01e0: 20 28 2b 20 31 20 69 29 20 6c 65 6e 29 20 28 73 (+ 1 i) len) (s 01f0: 74 72 69 6e 67 2d 72 65 66 20 78 20 28 2b 20 31 tring-ref x (+ 1 0200: 20 69 29 29 20 23 66 29 5d 0a 09 09 09 09 20 5b i)) #f)]..... [ 0210: 63 20 28 69 66 20 28 3e 20 69 20 30 29 20 28 73 c (if (> i 0) (s 0220: 74 72 69 6e 67 2d 72 65 66 20 78 20 28 2d 20 69 tring-ref x (- i 0230: 20 31 29 29 20 23 66 29 5d 29 0a 09 09 09 20 20 1)) #f)]).... 0240: 20 20 20 28 69 66 20 28 61 6e 64 20 28 63 68 61 (if (and (cha 0250: 72 2d 75 70 70 65 72 2d 63 61 73 65 3f 20 61 29 r-upper-case? a) 0260: 20 0a 09 09 09 09 20 20 20 20 20 20 62 20 28 6e ..... b (n 0270: 6f 74 20 28 63 68 61 72 2d 75 70 70 65 72 2d 63 ot (char-upper-c 0280: 61 73 65 3f 20 62 29 29 20 63 20 28 6e 6f 74 20 ase? b)) c (not 0290: 28 63 68 61 72 2d 75 70 70 65 72 2d 63 61 73 65 (char-upper-case 02a0: 3f 20 63 29 29 29 0a 09 09 09 09 20 28 63 6f 6e ? c)))..... (con 02b0: 73 20 28 63 68 61 72 2d 64 6f 77 6e 63 61 73 65 s (char-downcase 02c0: 20 61 29 20 28 69 66 20 28 61 6e 64 20 63 20 28 a) (if (and c ( 02d0: 63 68 61 72 3d 3f 20 63 20 23 5c 2d 29 29 20 61 char=? c #\-)) a 02e0: 63 63 20 28 63 6f 6e 73 20 23 5c 2d 20 61 63 63 cc (cons #\- acc 02f0: 29 29 29 0a 09 09 09 09 20 28 63 6f 6e 73 20 28 )))..... (cons ( 0300: 63 68 61 72 2d 64 6f 77 6e 63 61 73 65 20 61 29 char-downcase a) 0310: 20 61 63 63 29 29 29 29 20 27 28 29 20 28 69 6f acc)))) '() (io 0320: 74 61 20 6c 65 6e 29 29 29 29 5d 29 0a 09 20 0a ta len))))]).. . 0330: 09 20 73 29 29 0a 20 20 20 20 20 0a 20 20 20 20 . s)). . 0340: 20 28 64 65 66 69 6e 65 20 28 72 65 6e 61 6d 65 (define (rename 0350: 2d 73 63 68 65 6d 65 2d 3e 63 20 74 79 70 65 29 -scheme->c type) 0360: 0a 20 20 20 20 20 20 20 28 63 6f 6e 64 20 5b 28 . (cond [( 0370: 63 61 73 65 20 28 73 79 6e 74 61 78 2d 3e 64 61 case (syntax->da 0380: 74 75 6d 20 74 79 70 65 29 0a 09 09 5b 28 75 6e tum type)...[(un 0390: 6b 6e 6f 77 6e 29 20 27 75 6e 6b 6e 6f 77 6e 5d known) 'unknown] 03a0: 0a 09 09 5b 65 6c 73 65 20 23 66 5d 29 0a 09 20 ...[else #f]).. 03b0: 20 20 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 20 => (lambda 03c0: 28 74 29 0a 09 09 20 20 20 28 64 61 74 75 6d 2d (t)... (datum- 03d0: 3e 73 79 6e 74 61 78 20 74 79 70 65 20 74 29 29 >syntax type t)) 03e0: 5d 0a 09 20 20 20 20 20 5b 65 6c 73 65 20 74 79 ].. [else ty 03f0: 70 65 5d 29 29 0a 0a 20 20 20 20 20 28 64 65 66 pe])).. (def 0400: 69 6e 65 20 28 63 6f 6e 76 65 72 74 2d 73 63 68 ine (convert-sch 0410: 65 6d 65 2d 3e 63 20 66 75 6e 63 74 69 6f 6e 2d eme->c function- 0420: 6e 61 6d 65 20 6e 61 6d 65 20 74 79 70 65 29 0a name name type). 0430: 20 20 20 20 20 20 20 6e 61 6d 65 29 0a 0a 20 20 name).. 0440: 20 20 20 28 64 65 66 69 6e 65 20 28 64 61 74 75 (define (datu 0450: 6d 2d 3e 73 74 72 69 6e 67 20 78 29 0a 20 20 20 m->string x). 0460: 20 20 20 20 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 (symbol->str 0470: 69 6e 67 20 28 73 79 6e 74 61 78 2d 3e 64 61 74 ing (syntax->dat 0480: 75 6d 20 78 29 29 29 0a 0a 20 20 20 20 20 28 64 um x))).. (d 0490: 65 66 69 6e 65 20 28 73 74 72 69 6e 67 2d 3e 64 efine (string->d 04a0: 61 74 75 6d 20 74 20 78 29 0a 20 20 20 20 20 20 atum t x). 04b0: 20 28 64 61 74 75 6d 2d 3e 73 79 6e 74 61 78 20 (datum->syntax 04c0: 74 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f t (string->symbo 04d0: 6c 20 78 29 29 29 0a 0a 20 20 20 20 20 28 73 79 l x))).. (sy 04e0: 6e 74 61 78 2d 63 61 73 65 20 78 20 28 29 0a 20 ntax-case x (). 04f0: 20 20 20 20 20 20 5b 28 5f 20 72 65 74 2d 74 79 [(_ ret-ty 0500: 70 65 20 6e 61 6d 65 20 28 28 61 72 67 2d 6e 61 pe name ((arg-na 0510: 6d 65 20 61 72 67 2d 74 79 70 65 29 20 2e 2e 2e me arg-type) ... 0520: 29 20 63 2d 6e 61 6d 65 29 20 0a 09 28 77 69 74 ) c-name) ..(wit 0530: 68 2d 73 79 6e 74 61 78 20 28 3b 5b 6e 61 6d 65 h-syntax (;[name 0540: 2f 73 74 72 69 6e 67 20 28 64 61 74 75 6d 2d 3e /string (datum-> 0550: 73 74 72 69 6e 67 20 23 27 6e 61 6d 65 29 5d 0a string #'name)]. 0560: 09 09 20 20 20 20 20 20 3b 5b 6e 61 6d 65 20 28 .. ;[name ( 0570: 73 74 72 69 6e 67 2d 3e 64 61 74 75 6d 20 23 27 string->datum #' 0580: 6e 61 6d 65 20 28 61 6e 74 69 2d 63 61 6d 65 6c name (anti-camel 0590: 20 28 64 61 74 75 6d 2d 3e 73 74 72 69 6e 67 20 (datum->string 05a0: 23 27 6e 61 6d 65 29 29 29 5d 0a 09 09 20 20 20 #'name)))]... 05b0: 20 20 20 5b 28 72 65 6e 61 6d 65 64 2d 74 79 70 [(renamed-typ 05c0: 65 20 2e 2e 2e 29 20 28 6d 61 70 20 72 65 6e 61 e ...) (map rena 05d0: 6d 65 2d 73 63 68 65 6d 65 2d 3e 63 20 23 27 28 me-scheme->c #'( 05e0: 61 72 67 2d 74 79 70 65 20 2e 2e 2e 29 29 5d 0a arg-type ...))]. 05f0: 09 09 20 20 20 20 20 20 5b 72 65 6e 61 6d 65 64 .. [renamed 0600: 2d 72 65 74 20 28 72 65 6e 61 6d 65 2d 73 63 68 -ret (rename-sch 0610: 65 6d 65 2d 3e 63 20 23 27 72 65 74 2d 74 79 70 eme->c #'ret-typ 0620: 65 29 5d 0a 09 09 20 20 20 20 20 20 5b 66 75 6e e)]... [fun 0630: 63 74 69 6f 6e 2d 66 74 79 70 65 20 28 64 61 74 ction-ftype (dat 0640: 75 6d 2d 3e 73 79 6e 74 61 78 20 23 27 6e 61 6d um->syntax #'nam 0650: 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f e (string->symbo 0660: 6c 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 l (string-append 0670: 20 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 (symbol->string 0680: 20 28 73 79 6e 74 61 78 2d 3e 64 61 74 75 6d 20 (syntax->datum 0690: 23 27 6e 61 6d 65 29 29 20 22 2d 66 74 22 29 29 #'name)) "-ft")) 06a0: 29 5d 0a 09 09 20 20 20 20 20 20 5b 28 28 61 72 )]... [((ar 06b0: 67 2d 6e 61 6d 65 20 61 72 67 2d 63 6f 6e 76 65 g-name arg-conve 06c0: 72 74 29 20 2e 2e 2e 29 20 28 6d 61 70 20 28 6c rt) ...) (map (l 06d0: 61 6d 62 64 61 20 28 6e 20 74 29 20 0a 09 09 09 ambda (n t) .... 06e0: 09 09 09 09 20 20 20 28 6c 69 73 74 20 6e 20 28 .... (list n ( 06f0: 63 6f 6e 76 65 72 74 2d 73 63 68 65 6d 65 2d 3e convert-scheme-> 0700: 63 20 23 27 6e 61 6d 65 20 6e 20 74 29 29 29 20 c #'name n t))) 0710: 0a 09 09 09 09 09 09 09 20 23 27 28 61 72 67 2d ........ #'(arg- 0720: 6e 61 6d 65 20 2e 2e 2e 29 20 23 27 28 61 72 67 name ...) #'(arg 0730: 2d 74 79 70 65 20 2e 2e 2e 29 29 5d 29 0a 09 09 -type ...))])... 0740: 20 20 20 20 20 23 60 28 62 65 67 69 6e 0a 09 09 #`(begin... 0750: 09 20 28 64 65 66 69 6e 65 20 28 6e 61 6d 65 20 . (define (name 0760: 61 72 67 2d 6e 61 6d 65 20 2e 2e 2e 29 20 0a 09 arg-name ...) .. 0770: 09 09 20 20 20 28 64 65 66 69 6e 65 2d 66 74 79 .. (define-fty 0780: 70 65 20 66 75 6e 63 74 69 6f 6e 2d 66 74 79 70 pe function-ftyp 0790: 65 20 28 66 75 6e 63 74 69 6f 6e 20 28 72 65 6e e (function (ren 07a0: 61 6d 65 64 2d 74 79 70 65 20 2e 2e 2e 29 20 72 amed-type ...) r 07b0: 65 6e 61 6d 65 64 2d 72 65 74 29 29 0a 09 09 09 enamed-ret)).... 07c0: 20 20 20 28 6c 65 74 2a 20 28 5b 66 75 6e 63 74 (let* ([funct 07d0: 69 6f 6e 2d 66 70 74 72 20 20 28 6d 61 6b 65 2d ion-fptr (make- 07e0: 66 74 79 70 65 2d 70 6f 69 6e 74 65 72 20 66 75 ftype-pointer fu 07f0: 6e 63 74 69 6f 6e 2d 66 74 79 70 65 20 63 2d 6e nction-ftype c-n 0800: 61 6d 65 29 5d 0a 09 09 09 09 20 20 5b 66 75 6e ame)]..... [fun 0810: 63 74 69 6f 6e 20 20 20 20 20 20 20 28 66 74 79 ction (fty 0820: 70 65 2d 72 65 66 20 66 75 6e 63 74 69 6f 6e 2d pe-ref function- 0830: 66 74 79 70 65 20 28 29 20 66 75 6e 63 74 69 6f ftype () functio 0840: 6e 2d 66 70 74 72 29 5d 0a 09 09 09 09 20 20 5b n-fptr)]..... [ 0850: 61 72 67 2d 6e 61 6d 65 20 61 72 67 2d 63 6f 6e arg-name arg-con 0860: 76 65 72 74 5d 20 2e 2e 2e 29 0a 09 09 09 20 20 vert] ...).... 0870: 20 20 20 28 6c 65 74 20 28 5b 72 65 73 75 6c 74 (let ([result 0880: 20 28 66 75 6e 63 74 69 6f 6e 20 61 72 67 2d 6e (function arg-n 0890: 61 6d 65 20 2e 2e 2e 29 5d 29 0a 09 09 09 20 20 ame ...)]).... 08a0: 20 20 20 20 20 23 2c 28 63 61 73 65 20 28 73 79 #,(case (sy 08b0: 6e 74 61 78 2d 3e 64 61 74 75 6d 20 23 27 72 65 ntax->datum #'re 08c0: 74 2d 74 79 70 65 29 0a 09 09 09 09 20 20 20 5b t-type)..... [ 08d0: 28 69 6e 74 25 29 20 20 20 20 20 20 20 20 20 20 (int%) 08e0: 20 20 20 23 27 28 69 66 20 28 3c 20 72 65 73 75 #'(if (< resu 08f0: 6c 74 20 30 29 20 28 72 61 69 73 65 20 28 6d 61 lt 0) (raise (ma 0900: 6b 65 2d 73 64 6c 32 2d 63 6f 6e 64 69 74 69 6f ke-sdl2-conditio 0910: 6e 20 28 73 64 6c 2d 67 65 74 2d 65 72 72 6f 72 n (sdl-get-error 0920: 20 72 65 73 75 6c 74 29 29 29 29 5d 0a 09 09 09 result))))].... 0930: 09 20 20 20 5b 28 28 2a 20 73 64 6c 2d 74 65 78 . [((* sdl-tex 0940: 74 75 72 65 2d 74 29 0a 09 09 09 09 20 20 20 20 ture-t)..... 0950: 20 28 2a 20 73 64 6c 2d 73 75 72 66 61 63 65 2d (* sdl-surface- 0960: 74 29 0a 09 09 09 09 20 20 20 20 20 28 2a 20 73 t)..... (* s 0970: 64 6c 2d 63 75 72 73 6f 72 2d 74 29 0a 09 09 09 dl-cursor-t).... 0980: 09 20 20 20 20 20 28 2a 20 73 64 6c 2d 70 69 78 . (* sdl-pix 0990: 65 6c 2d 66 6f 72 6d 61 74 2d 74 29 0a 09 09 09 el-format-t).... 09a0: 09 20 20 20 20 20 28 2a 20 73 64 6c 2d 70 61 6c . (* sdl-pal 09b0: 65 74 74 65 2d 74 29 0a 09 09 09 09 20 20 20 20 ette-t)..... 09c0: 20 28 2a 20 73 64 6c 2d 72 77 2d 6f 70 73 2d 74 (* sdl-rw-ops-t 09d0: 29 0a 09 09 09 09 20 20 20 20 20 28 2a 20 73 64 )..... (* sd 09e0: 6c 2d 6d 75 74 65 78 2d 74 29 0a 09 09 09 09 20 l-mutex-t)..... 09f0: 20 20 20 20 28 2a 20 73 64 6c 2d 77 69 6e 64 6f (* sdl-windo 0a00: 77 2d 74 29 0a 09 09 09 09 20 20 20 20 20 28 2a w-t)..... (* 0a10: 20 73 64 6c 2d 73 65 6d 2d 74 29 0a 09 09 09 09 sdl-sem-t)..... 0a20: 20 20 20 20 20 28 2a 20 73 64 6c 2d 63 6f 6e 64 (* sdl-cond 0a30: 2d 74 29 0a 09 09 09 09 20 20 20 20 20 28 2a 20 -t)..... (* 0a40: 73 64 6c 2d 72 65 6e 64 65 72 65 72 2d 74 29 29 sdl-renderer-t)) 0a50: 20 20 23 27 28 73 64 6c 2d 67 75 61 72 64 2d 70 #'(sdl-guard-p 0a60: 6f 69 6e 74 65 72 20 72 65 73 75 6c 74 29 5d 0a ointer result)]. 0a70: 09 09 09 09 20 20 20 5b 65 6c 73 65 20 23 27 72 .... [else #'r 0a80: 65 73 75 6c 74 5d 29 29 29 29 29 29 5d 29 29 29 esult]))))))]))) 0a90: 0a 20 20 20 20 20 0a 20 28 64 65 66 69 6e 65 2d . . (define- 0aa0: 73 79 6e 74 61 78 20 6e 65 77 2d 73 74 72 75 63 syntax new-struc 0ab0: 74 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 t. (lambda (x) 0ac0: 0a 20 20 20 20 20 28 73 79 6e 74 61 78 2d 63 61 . (syntax-ca 0ad0: 73 65 20 78 20 28 29 0a 20 20 20 20 20 20 20 5b se x (). [ 0ae0: 28 5f 20 66 74 79 70 65 2d 6e 61 6d 65 20 28 66 (_ ftype-name (f 0af0: 69 65 6c 64 20 76 61 6c 75 65 29 20 2e 2e 2e 20 ield value) ... 0b00: 29 0a 09 23 27 28 6c 65 74 20 28 5b 6f 62 6a 65 )..#'(let ([obje 0b10: 63 74 20 28 6d 61 6b 65 2d 66 74 79 70 65 2d 70 ct (make-ftype-p 0b20: 6f 69 6e 74 65 72 20 0a 09 09 09 20 66 74 79 70 ointer .... ftyp 0b30: 65 2d 6e 61 6d 65 0a 09 09 09 20 28 66 6f 72 65 e-name.... (fore 0b40: 69 67 6e 2d 61 6c 6c 6f 63 20 28 66 74 79 70 65 ign-alloc (ftype 0b50: 2d 73 69 7a 65 6f 66 20 66 74 79 70 65 2d 6e 61 -sizeof ftype-na 0b60: 6d 65 29 29 29 5d 29 0a 09 20 20 20 20 28 66 74 me)))]).. (ft 0b70: 79 70 65 2d 73 65 74 21 20 66 74 79 70 65 2d 6e ype-set! ftype-n 0b80: 61 6d 65 20 28 66 69 65 6c 64 29 20 6f 62 6a 65 ame (field) obje 0b90: 63 74 20 76 61 6c 75 65 29 20 2e 2e 2e 0a 09 20 ct value) ..... 0ba0: 20 20 20 28 73 64 6c 2d 67 75 61 72 64 2d 70 6f (sdl-guard-po 0bb0: 69 6e 74 65 72 20 6f 62 6a 65 63 74 29 29 5d 29 inter object))]) 0bc0: 29 29 0a 0a 0a 3b 3b 20 54 68 69 73 20 69 73 20 ))...;; This is 0bd0: 75 73 65 66 75 6c 20 69 66 20 74 68 65 20 63 20 useful if the c 0be0: 66 75 6e 63 74 69 6f 6e 20 72 65 74 75 72 6e 73 function returns 0bf0: 20 76 61 6c 75 65 73 20 62 79 20 72 65 66 65 72 values by refer 0c00: 65 6e 63 65 20 28 70 6f 69 6e 74 65 72 73 29 0a ence (pointers). 0c10: 3b 3b 20 74 68 65 20 6d 61 63 72 6f 20 61 75 74 ;; the macro aut 0c20: 6f 6d 61 74 69 63 61 6c 6c 79 20 61 6c 6c 6f 63 omatically alloc 0c30: 61 74 65 73 20 74 68 65 20 76 61 72 69 61 62 6c ates the variabl 0c40: 65 73 20 61 6e 64 20 72 65 66 65 72 65 6e 63 65 es and reference 0c50: 73 20 74 68 65 20 76 61 6c 75 65 73 20 61 66 74 s the values aft 0c60: 65 72 20 74 68 65 20 63 61 6c 6c 2e 0a 3b 3b 0a er the call..;;. 0c70: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 73 (define-syntax s 0c80: 64 6c 2d 6c 65 74 2d 72 65 66 2d 63 61 6c 6c 0a dl-let-ref-call. 0c90: 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 (lambda (x). 0ca0: 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 78 (syntax-case x 0cb0: 20 28 29 0a 20 20 20 20 20 20 5b 28 6b 20 66 75 (). [(k fu 0cc0: 6e 63 20 28 70 61 72 61 6d 20 2e 2e 2e 29 20 72 nc (param ...) r 0cd0: 65 73 75 6c 74 20 62 6f 64 79 20 2e 2e 2e 29 20 esult body ...) 0ce0: 0a 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 79 . (with-sy 0cf0: 6e 74 61 78 20 28 5b 28 28 76 61 72 20 76 61 6c ntax ([((var val 0d00: 29 20 2e 2e 2e 29 20 28 6d 61 70 20 28 6c 61 6d ) ...) (map (lam 0d10: 62 64 61 20 28 70 29 0a 09 09 09 09 09 20 20 20 bda (p)...... 0d20: 20 20 28 6c 65 74 20 28 5b 70 2a 20 28 73 79 6e (let ([p* (syn 0d30: 74 61 78 2d 3e 64 61 74 75 6d 20 70 29 5d 29 0a tax->datum p)]). 0d40: 09 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if 0d50: 28 70 61 69 72 3f 20 70 2a 29 0a 09 09 09 09 09 (pair? p*)...... 0d60: 09 20 20 20 28 6c 69 73 74 20 28 64 61 74 75 6d . (list (datum 0d70: 2d 3e 73 79 6e 74 61 78 20 23 27 6b 20 28 63 61 ->syntax #'k (ca 0d80: 72 20 70 2a 29 29 20 0a 09 09 09 09 09 09 09 20 r p*)) ........ 0d90: 23 60 28 73 64 6c 2d 67 75 61 72 64 2d 70 6f 69 #`(sdl-guard-poi 0da0: 6e 74 65 72 20 0a 09 09 09 09 09 09 09 20 20 20 nter ........ 0db0: 20 28 6d 61 6b 65 2d 66 74 79 70 65 2d 70 6f 69 (make-ftype-poi 0dc0: 6e 74 65 72 20 0a 09 09 09 09 09 09 09 20 20 20 nter ........ 0dd0: 20 20 23 2c 28 64 61 74 75 6d 2d 3e 73 79 6e 74 #,(datum->synt 0de0: 61 78 20 23 27 6b 20 28 63 61 64 72 20 70 2a 29 ax #'k (cadr p*) 0df0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 66 )........ (f 0e00: 6f 72 65 69 67 6e 2d 61 6c 6c 6f 63 20 0a 09 09 oreign-alloc ... 0e10: 09 09 09 09 09 20 20 20 20 20 20 28 66 74 79 70 ..... (ftyp 0e20: 65 2d 73 69 7a 65 6f 66 20 23 2c 28 64 61 74 75 e-sizeof #,(datu 0e30: 6d 2d 3e 73 79 6e 74 61 78 20 23 27 6b 20 28 63 m->syntax #'k (c 0e40: 61 64 72 20 70 2a 29 29 29 29 29 29 29 0a 09 09 adr p*)))))))... 0e50: 09 09 09 09 20 20 20 28 6c 69 73 74 20 70 20 70 .... (list p p 0e60: 29 29 29 29 20 23 27 28 70 61 72 61 6d 20 2e 2e )))) #'(param .. 0e70: 2e 29 29 5d 29 0a 09 09 20 20 20 20 28 77 69 74 .))])... (wit 0e80: 68 2d 73 79 6e 74 61 78 0a 09 09 20 20 20 20 20 h-syntax... 0e90: 28 5b 28 76 61 6c 32 20 2e 2e 2e 29 20 28 6d 61 ([(val2 ...) (ma 0ea0: 70 20 28 6c 61 6d 62 64 61 20 28 70 20 76 29 0a p (lambda (p v). 0eb0: 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 ..... (let ( 0ec0: 5b 70 2a 20 28 73 79 6e 74 61 78 2d 3e 64 61 74 [p* (syntax->dat 0ed0: 75 6d 20 70 29 5d 29 0a 09 09 09 09 09 20 20 20 um p)])...... 0ee0: 20 20 20 20 28 69 66 20 28 70 61 69 72 3f 20 70 (if (pair? p 0ef0: 2a 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 69 *)....... (i 0f00: 66 20 28 6d 65 6d 71 20 27 26 20 70 2a 29 0a 09 f (memq '& p*).. 0f10: 09 09 09 09 09 09 20 23 60 28 66 74 79 70 65 2d ...... #`(ftype- 0f20: 26 72 65 66 0a 09 09 09 09 09 09 09 20 20 20 20 &ref........ 0f30: 23 2c 28 64 61 74 75 6d 2d 3e 73 79 6e 74 61 78 #,(datum->syntax 0f40: 20 23 27 6b 20 28 63 61 64 72 20 70 2a 29 29 0a #'k (cadr p*)). 0f50: 09 09 09 09 09 09 09 20 20 20 20 28 29 0a 09 09 ....... ()... 0f60: 09 09 09 09 09 20 20 20 20 23 2c 76 29 0a 09 09 ..... #,v)... 0f70: 09 09 09 09 09 20 23 60 28 66 74 79 70 65 2d 72 ..... #`(ftype-r 0f80: 65 66 20 0a 09 09 09 09 09 09 09 20 20 20 20 23 ef ........ # 0f90: 2c 28 64 61 74 75 6d 2d 3e 73 79 6e 74 61 78 20 ,(datum->syntax 0fa0: 23 27 6b 20 28 63 61 64 72 20 70 2a 29 29 0a 09 #'k (cadr p*)).. 0fb0: 09 09 09 09 09 09 20 20 20 20 28 29 0a 09 09 09 ...... ().... 0fc0: 09 09 09 09 20 20 20 20 23 2c 76 29 29 0a 09 09 .... #,v))... 0fd0: 09 09 09 09 20 20 20 70 29 29 29 20 23 27 28 70 .... p))) #'(p 0fe0: 61 72 61 6d 20 2e 2e 2e 29 20 23 27 28 76 61 72 aram ...) #'(var 0ff0: 20 2e 2e 2e 29 20 29 5d 29 0a 09 09 20 20 20 20 ...) )])... 1000: 20 23 27 28 6c 65 74 20 28 5b 76 61 72 20 76 61 #'(let ([var va 1010: 6c 5d 20 2e 2e 2e 29 0a 09 09 09 20 28 6c 65 74 l] ...).... (let 1020: 20 28 5b 72 65 73 75 6c 74 20 28 66 75 6e 63 20 ([result (func 1030: 76 61 72 20 2e 2e 2e 29 5d 29 0a 09 09 09 20 20 var ...)]).... 1040: 20 28 6c 65 74 20 28 28 76 61 72 20 76 61 6c 32 (let ((var val2 1050: 29 20 2e 2e 2e 29 0a 09 09 09 20 20 20 20 20 62 ) ...).... b 1060: 6f 64 79 20 2e 2e 2e 29 29 29 29 29 5d 29 29 29 ody ...)))))]))) 1070: 0a .