;;;; symbol-access.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18

(declare
  (bound-to-procedure
    ##sys#symbol-has-toplevel-binding?))

(module symbol-access

(;export
  ;
  global-symbol-bound?
  global-symbol-ref
  ;
  internal-module-name?
  ;
  *toplevel-module-symbol*
  split-prefixed-symbol)

(import scheme
  (chicken base)
  (chicken fixnum)
  (chicken type)
  (only (srfi 13) string-prefix? string-drop string-take string-index))

;;; Raw Access Renames

(define (global-symbol-bound? sym) (##sys#symbol-has-toplevel-binding? sym))

(define (global-symbol-ref sym) (##sys#slot sym 0))

(define (global-symbol-name-offset str)
  (if (string-prefix? "##" str) 2 0) )

;;; Toplevel Symbols

(define *toplevel-module-symbol* '||)

(define *toplevel-module-string* (symbol->string *toplevel-module-symbol*))

(: internal-module-name? (string --> boolean))
;
(define (internal-module-name? str)
  (not (zero? (global-symbol-name-offset str))) )

(: split-prefixed-symbol (symbol --> string string))
;
(define (split-prefixed-symbol sym)
  (let* (
    (str (symbol->string sym))
    (idx (string-index str #\# (global-symbol-name-offset str)))
    (mod (if idx (string-take str idx) *toplevel-module-string*))
    (nam (if idx (string-drop str (fx+ 1 idx)) str)) )
    ;
    (values mod nam) ) )

) ;module symbol-access