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

Last change on this file since 37095 was 37095, checked in by kon, 6 months ago

fix #1578, add internal kwd arg, add split test

File size: 1.3 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  internal-module-name?
16  ;
17  *toplevel-module-symbol*
18  split-prefixed-symbol)
19
20(import scheme
21  (chicken base)
22  (chicken fixnum)
23  (chicken type)
24  (only (srfi 13) string-prefix? string-drop string-take string-index))
25
26;;; Raw Access Renames
27
28(define (global-symbol-bound? sym) (##sys#symbol-has-toplevel-binding? sym))
29
30(define (global-symbol-ref sym) (##sys#slot sym 0))
31
32(define (global-symbol-name-offset str)
33  (if (string-prefix? "##" str) 2 0) )
34
35;;; Toplevel Symbols
36
37(define *toplevel-module-symbol* '||)
38
39(define *toplevel-module-string* (symbol->string *toplevel-module-symbol*))
40
41(: internal-module-name? (string --> boolean))
42;
43(define (internal-module-name? str)
44  (not (zero? (global-symbol-name-offset str))) )
45
46(: split-prefixed-symbol (symbol --> string string))
47;
48(define (split-prefixed-symbol sym)
49  (let* (
50    (str (symbol->string sym))
51    (idx (string-index str #\# (global-symbol-name-offset str)))
52    (mod (if idx (string-take str idx) *toplevel-module-string*))
53    (nam (if idx (string-drop str (fx+ 1 idx)) str)) )
54    ;
55    (values mod nam) ) )
56
57) ;module symbol-access
Note: See TracBrowser for help on using the repository browser.