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

Last change on this file since 36298 was 36298, checked in by Kon Lovett, 12 months ago

more own mods

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)
23    string-drop string-take string-index))
24
25;;; Raw Access Renames
26
27(define (global-symbol-bound? sym)
28  (##sys#symbol-has-toplevel-binding? sym) )
29
30(define (global-symbol-ref sym)
31  (##sys#slot sym 0) )
32
33;;; Toplevel Symbols
34
35(define *toplevel-module-symbol* '||)
36
37(define *toplevel-module-string* (symbol->string *toplevel-module-symbol*))
38
39(: split-prefixed-symbol (symbol --> string string))
40;
41(define (split-prefixed-symbol sym)
42  (let* (
43    (str (symbol->string sym))
44    ;assume # not part of module name
45    (idx (string-index str #\#))
46    (mod (if idx (string-take str idx) *toplevel-module-string*))
47    (nam (if idx (string-drop str (fx+ 1 idx)) str)) )
48    ;
49    (values mod nam) ) )
50
51) ;module symbol-access
Note: See TracBrowser for help on using the repository browser.