source: project/release/3/misc-extn/trunk/misc-extn-symbol-support.scm @ 10987

Last change on this file since 10987 was 9512, checked in by Kon Lovett, 13 years ago

Rmvd dep procs. Updated doc.

File size: 1.7 KB
Line 
1;;;; misc-extn-symbol-support.scm
2;;;; Kon Lovett, Mar '05
3
4(eval-when (compile)
5  (declare
6    (usual-integrations)
7    (fixnum)
8    (inline)
9    (no-procedure-checks)
10    (no-bound-checks)
11    (bound-to-procedure
12      ##sys#interned-symbol?
13      ##sys#make-symbol
14      ##sys#symbol->qualified-string
15      ##sys#qualified-symbol-prefix
16      ##sys#intern-symbol )
17    (export
18      interned-symbol?
19      symbol->qualified-string
20      make-qualified-uninterned-symbol
21      make-qualified-symbol
22      qualified-symbol? ) ) )
23
24;;
25
26(define (check-symbol obj loc)
27  (unless (symbol? obj)
28    (error loc "invalid symbol" obj) ) )
29
30#;
31(define (check-symbol-or-string obj loc)
32  (unless (or (symbol? obj) (string? obj))
33    (error loc "invalid symbol or string" obj) ) )
34
35(define-constant NAMESPACE-MAX-ID-LEN 31)
36
37(define (make-qualified-string ns sym loc)
38  (check-symbol sym loc)
39  (let* ([ns (->string ns)]
40         [nsl (string-length ns)])
41    (if (<= 1 nsl NAMESPACE-MAX-ID-LEN)
42        (conc (integer->char nsl) ns sym)
43        (error loc "invalid namespace identifier length" ns) ) ) )
44
45;; Chicken namespace qualified symbol.
46
47(define (make-qualified-symbol ns sym)
48  (##sys#intern-symbol (make-qualified-string ns sym 'make-qualified-symbol)) )
49
50(define (make-qualified-uninterned-symbol ns sym)
51  (##sys#make-symbol (make-qualified-string ns sym 'make-qualified-symbol)) )
52
53(define (qualified-symbol? sym)
54  (check-symbol sym 'qualified-symbol?)
55  (and (##sys#qualified-symbol-prefix sym)
56       #t ) )
57
58(define (symbol->qualified-string sym)
59  (check-symbol sym 'symbol->qualified-string)
60  (##sys#symbol->qualified-string sym) )
61
62(define (interned-symbol? sym)
63  (check-symbol sym 'interned-symbol?)
64  (##sys#interned-symbol? sym) )
65 
Note: See TracBrowser for help on using the repository browser.