27 lines
945 B
Racket
27 lines
945 B
Racket
#lang scheme/base
|
|
|
|
(require (for-template racket/base "defined-checks.rkt"))
|
|
(provide make-term-fn
|
|
term-fn?
|
|
term-fn-get-id
|
|
(struct-out term-id)
|
|
(struct-out judgment-form)
|
|
judgment-form-id?
|
|
defined-check)
|
|
|
|
(define-values (struct-type make-term-fn term-fn? term-fn-get term-fn-set!)
|
|
(make-struct-type 'term-fn #f 1 0))
|
|
(define term-fn-get-id (make-struct-field-accessor term-fn-get 0))
|
|
|
|
(define-struct term-id (id depth))
|
|
|
|
(define-struct judgment-form (name mode proc lang lws))
|
|
|
|
(define (judgment-form-id? stx)
|
|
(and (identifier? stx)
|
|
(judgment-form? (syntax-local-value stx (λ () 'not-a-judgment-form)))))
|
|
|
|
(define (defined-check id desc #:external [external id])
|
|
(if (eq? (identifier-binding id) 'lexical)
|
|
(quasisyntax/loc external (check-defined-lexical #,id '#,external #,desc))
|
|
(quasisyntax/loc external (check-defined-module (λ () #,id) '#,external #,desc)))) |