source: project/release/5/apropos/trunk/symbol-access.scm @ 36630

Last change on this file since 36630 was 36630, checked in by kon, 8 months ago

comments

File size: 1.1 KB
Line 
1;;;; symbol-access.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3
4(declare
5  (bound-to-procedure
6    ##sys#symbol-has-toplevel-binding?))
7
8(module symbol-access
9
10(;export
11  ;
12  global-symbol-bound?
13  global-symbol-ref
14  ;
15  *toplevel-module-symbol*
16  split-prefixed-symbol)
17
18(import scheme
19  (chicken base)
20  (chicken fixnum)
21  (chicken type)
22  (only (srfi 13) string-drop string-take string-index))
23
24;;; Raw Access Renames
25
26(define (global-symbol-bound? sym) (##sys#symbol-has-toplevel-binding? sym))
27
28(define (global-symbol-ref sym) (##sys#slot sym 0))
29
30;;; Toplevel Symbols
31
32(define *toplevel-module-symbol* '||)
33
34(define *toplevel-module-string* (symbol->string *toplevel-module-symbol*))
35
36(: split-prefixed-symbol (symbol --> string string))
37;
38(define (split-prefixed-symbol sym)
39  (let* (
40    (str (symbol->string sym))
41    ;assume # not part of module name (-right would mean # not part of symbol)
42    ;so cannot handle qualified symbols
43    (idx (string-index str #\#))
44    (mod (if idx (string-take str idx) *toplevel-module-string*))
45    (nam (if idx (string-drop str (fx+ 1 idx)) str)) )
46    ;
47    (values mod nam) ) )
48
49) ;module symbol-access
Note: See TracBrowser for help on using the repository browser.