47 lines
1.7 KiB
Scheme
47 lines
1.7 KiB
Scheme
(module imageeq mzscheme
|
|
|
|
(define op (current-output-port))
|
|
|
|
;; Flag to indicate whether we've tried to load
|
|
;; the MrEd-using image functions
|
|
(define tried? #f)
|
|
|
|
;; This macro is used once to export all functions
|
|
;; from "private/image.ss":
|
|
(define-syntax (re-export stx)
|
|
(syntax-case stx ()
|
|
[(_ (id . impl) ...)
|
|
(with-syntax ([(got-id ...) (generate-temporaries #'(id ...))])
|
|
#'(begin
|
|
(provide id ...)
|
|
(re-export-one get-procs! id got-id . impl) ...
|
|
(define got-id #f) ...
|
|
(define (get-procs!)
|
|
(unless tried?
|
|
(set! tried? #t)
|
|
(with-handlers ([exn:fail? (lambda (x) #f)])
|
|
(set! got-id (dynamic-require 'lang/private/imageeq 'id))
|
|
...)))))]))
|
|
|
|
;; This macro is used once for each individual function,
|
|
;; and the use is generated by `re-export':
|
|
(define-syntax (re-export-one stx)
|
|
(syntax-case stx ()
|
|
[(_ get-procs! id got-id args alt ...)
|
|
(with-syntax ([alt (if (null? (syntax-e #'(alt ...)))
|
|
#'(raise-type-error 'id "image" 0 . args)
|
|
#'(alt ... . args))])
|
|
|
|
#'(define (id . args)
|
|
(get-procs!)
|
|
(if got-id
|
|
(got-id . args)
|
|
alt)))]))
|
|
|
|
;; Each re-export is the name, formals for the argument,
|
|
;; and if the first argument isn't required to be an image,
|
|
;; a function to apply when the real version is unavailable
|
|
;; (i.e., because there's no MrEd)
|
|
(re-export (image? (x) (lambda (x) #f))
|
|
(image=? (a b))))
|