source: project/lexmod/lexmod-base.scm @ 2659

Last change on this file since 2659 was 2659, checked in by felix winkelmann, 13 years ago

added lexmod

File size: 1.6 KB
Line 
1;;; (C) 2003 Taylor Campbell.
2;;; All rights reserved.
3;;;
4;;; For details, see the LICENCE file, which should have come in the
5;;; lexmod distribution.
6
7(define (lexmod-version) '(008 final)) ; fnord
8
9(define lexmod:get-defined-tag "get-defined")
10(define lexmod:get-modname-tag "get-modname")
11
12(define (lexmod-name mod) (mod lexmod:get-modname-tag))
13
14;;; It might be better to include this in the neutral table interface,
15;;; rather than WALK-SYMBOL-TABLE, especially since CALL/CC can be
16;;; expensive and SYMBOL-TABLE-EVERY? needn't be.  (of course, CALL/CC
17;;; _shouldn't_ be expensive, but some Scheme implementations suck...)
18(define (symbol-table-every? f t)
19  (call-with-current-continuation
20   (lambda (return)
21     (hash-table-walk t (lambda (k v) (if (not (f k v)) (return #f))))
22     #t)))
23
24;;; Might it be better to turn this into an ADT, disjoint from tables?
25(define (interface? x)
26  (and (hash-table? x)
27       (symbol-table-every? (lambda (k v) (eqv? v #t)) x)))
28
29(define (interface-exports? interface symbol)
30  (hash-table-ref/default interface symbol #f) )
31
32(define (lexmod-exports? mod symbol)
33  (and (hash-table-ref/default (mod lexmod:get-defined-tag) symbol #f)
34       #t))
35
36(define (lexmod-satisfies? mod interface)
37  (symbol-table-every? (lambda (symbol _)
38                         (lexmod-exports? mod symbol))
39                       interface))
40
41(define (lexmod:assert-satisfies mod interface)
42  (if (not (lexmod-satisfies? mod interface))
43      (error "lexmod does not satisfy interface"
44             (lexmod-name mod)
45             mod
46             interface)))
Note: See TracBrowser for help on using the repository browser.