;; Defines a language to be used by info.ss files (module infotab mzscheme (define-syntax info-module-begin (lambda (stx) (syntax-case stx () [(mod-beg defn ...) (let ([names (let loop ([defns (syntax->list (syntax (defn ...)))] [r '()]) (if (null? defns) (reverse! r) (loop (cdr defns) (syntax-case (car defns) (define) [(define var val) (cons (syntax var) r)] ;; In case it gets expanded: [(define-values (var) val) (cons (syntax var) r)] [(require lib) r] ; ignore these (see below) [_else (raise-syntax-error 'infotab-module "not a well-formed definition" stx (car defns))]))))]) (let ([dup (check-duplicate-identifier names)]) (when dup (raise-syntax-error 'infotab-module "duplicate definition" stx dup))) (with-syntax ([(name ...) names]) (syntax (#%plain-module-begin defn ... (define #%info-lookup (case-lambda [(n) (#%info-lookup n (lambda () (error 'info.ss "no info for ~a" n)))] [(n fail) (unless (and (procedure? fail) (procedure-arity-includes? fail 0)) (error 'info.ss "expected second argument to be a procedure that takes no arguments, got: ~e" fail)) (case n [(name) name] ... [else (fail)])])) (define (#%info-domain) '(name ...)) (provide #%info-lookup #%info-domain)))))]))) (define-syntax (limited-require stx) (syntax-case stx () [(_ lib) (member (syntax-object->datum #'lib) '((lib "string-constant.ss" "string-constants"))) (syntax/loc stx (require lib))])) (provide (rename info-module-begin #%module-begin) #%app #%datum #%top define quote list cons car cdr quasiquote unquote unquote-splicing list* append reverse path->string build-path collection-path system-library-subpath (rename limited-require require)))