File: features.ss

package info (click to toggle)
drscheme 1%3A352-6
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 71,608 kB
  • ctags: 55,284
  • sloc: ansic: 278,966; cpp: 63,318; sh: 32,265; lisp: 14,530; asm: 7,327; makefile: 4,846; pascal: 4,363; perl: 2,920; java: 1,632; yacc: 755; lex: 258; sed: 93; xml: 12
file content (30 lines) | stat: -rw-r--r-- 893 bytes parent folder | download | duplicates (2) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
(module features mzscheme
  (provide feature-present?
	   feature->require-clause)

  (define *feature-alist*
    '())

  (define (srfi-id? id)
    (let ((string-id (symbol->string id)))
      (and (> (string-length string-id) 5)
	   (string=? "srfi-"
		     (substring string-id 0 5)))))

  (define (srfi-id->filename srfi-id)
    (let ((string-id (symbol->string srfi-id)))
      (string-append (substring string-id 5 (string-length string-id))
		     ".ss")))

  (define (srfi-id-present? srfi-id)
    (file-exists? (build-path (collection-path "srfi")
			      (srfi-id->filename srfi-id))))

  (define (feature-present? id)
    (or (and (srfi-id? id) (srfi-id-present? id))
	(and (assq id *feature-alist*) #t)))

  (define (feature->require-clause id)
    (if (and (srfi-id? id) (srfi-id-present? id))
	(cons 'lib (list (srfi-id->filename id) "srfi"))
	(cdr (assq id *feature-alist*)))))