struct-member pasted by wasamasa on Sat Jan 9 22:39:10 2016

(define-syntax struct-member
  (syntax-rules ()
    ((struct-member record accessor ret-type struct-name member-name)
     (let ((record* (accessor record)))
       (when record*
         (let ((code (format "C_return(struct->~a);" member-name)))
           ((foreign-lambda* ret-type
                             (((c-pointer (struct struct-name))
                               struct))
                             code)
            record*)))))))

(define (gif-width gif)
  (struct-member gif gif-pointer int "GifFileType" "SWidth"))

(define (gif-height gif)
  (struct-member gif gif-pointer int "GifFileType" "SHeight"))

;; compiling the above yields the following backtrace:

;; Error: (string-append) bad argument type - not a string: code154
;;
;;        Call history:
;;
;;        <syntax>          (##core#begin (##core#let ((out162 out161)) (##sys#check-output
;;-port out162 #t (quote format)) (##sy......
;;        <syntax>          (##core#let ((out162 out161)) (##sys#check-output-port out162 #
;;t (quote format)) (##sys#print "C_ret...
;;        <syntax>          (##core#begin (##sys#check-output-port out162 #t (quote format)
;;) (##sys#print "C_return(struct->" #f...
;;        <syntax>          (##sys#check-output-port out162 #t (quote format))
;;        <syntax>          (quote format)
;;        <syntax>          (##core#quote format)
;;        <syntax>          (##sys#print "C_return(struct->" #f out162)
;;        <syntax>          (##sys#print "SWidth" #f out162)
;;        <syntax>          (##sys#print ");" #f out162)
;;        <syntax>          (get-output-string167 out161)
;;        <syntax>          (##core#begin ((foreign-lambda*156 int (((c-pointer157 (struct1
;;58 "GifFileType")) struct158)) code15......
;;        <syntax>          ((foreign-lambda*156 int (((c-pointer157 (struct158 "GifFileTyp
;;e")) struct158)) code154) record*152)
;;        <syntax>          (##core#let ((g174 (foreign-lambda*156 int (((c-pointer157 (str
;;uct158 "GifFileType")) struct158)) co......
;;        <syntax>          (foreign-lambda*156 int (((c-pointer157 (struct158 "GifFileType
;;")) struct158)) code154)
;;        <syntax>          (##core#the (procedure ((or boolean pointer locative)) fixnum)
;;#f (##core#foreign-lambda* int (((c-p......
;;        <syntax>          (##core#foreign-lambda* int (((c-pointer157 (struct158 "GifFile
;;Type")) struct158)) code154)    <--
[ permalink | raw ]

w/ ir-macro-transformer added by evhan on Sat Jan 9 22:45:02 2016

(use-for-syntax matchable)

(define-syntax struct-member
  (ir-macro-transformer
   (lambda (e i c)
     (match e
       ((struct-member record accessor ret-type struct-name member-name)
        `(let ((record* (,(i accessor) ,(i record))))
           (when record*
             ((foreign-lambda* ,(i ret-type)
                (((c-pointer (struct ,(i struct-name)))
                  struct))
                ,(format "C_return(struct->~a);" (i member-name)))
              record*))))))))
[ permalink | raw ]