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

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

(module symbol-access

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

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

;;;

;;

(define (internal-marker-prefix-length str)
  (cond
    ((string-skip str #\#) => identity)
    (else                             0)) )

(define (global-symbol-name-offset str)
  (string-index str #\# (internal-marker-prefix-length str)) )

;;;

;; Toplevel Symbols

(define-constant TOPLEVEL-MODULE-SYMBOL '||)

(: *toplevel-module-symbol* (deprecated toplevel-module-symbol))
(define *toplevel-module-symbol* TOPLEVEL-MODULE-SYMBOL)

(define toplevel-module-symbol (make-parameter TOPLEVEL-MODULE-SYMBOL (lambda (x)
  (or
    (and (symbol? x) x)
    (toplevel-module-symbol)))))

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

;; Raw Access Renames

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

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

;;

(: internal-module-name? (string --> boolean))
;
(define (internal-module-name? str)
  (not (zero? (internal-marker-prefix-length str))) )

(: split-prefixed-symbol (symbol --> string string))
;=> module-name identifier-name
;
(define (split-prefixed-symbol sym)
  (let* (
    ;symbol name (keyword w/o print-mark)
    (str (symbol->string sym))
    ;module break char index
    (idx (global-symbol-name-offset str)) )
    ;module?
    (if idx
      (values (string-take str idx) (string-drop str (fx+ 1 idx)))
      (values *toplevel-module-string* str) ) ) )

) ;module symbol-access