#lang scheme/base

;; Reflective operations on current-namespace = project
;; namespace. Intended in first place for (target) Scat namespace
;; lookup.

(require
 scheme/pretty
 scheme/control
 "../tools.ss"
;; "tethered.ss"
 "../scat.ss"
 "../target.ss")

(provide (all-defined-out))


;; Find the word in the current namespace.
(define (find-target-word/false name)
  (namespace-variable-value
   (ns-name '(target) name)
   #f (lambda () #f)))

(define (tfind/false name)
  (let ((word (find-target-word/false name)))
    (and word (target-word-address word))))

;; Note: compiled but not assembled means it's not found!
(define (tfind name)
  (or (tfind/false name)
      (error 'target-word-not-found "~s" name)))
    


(define (target-mapped-symbols)
  (filter tfind/false (ns-mapped-symbols '(target))))
    
  
;; Simple target dictionary read/write. This forgets assembly+binary code.
(define (target-words [words #f])
  (if words
      ;; Write to dictionary.
      (for-each*
       (lambda (name realm address)
         (let ((word
                (eval
                  `(new-target-word #:name ',name
                                    #:realm ',realm
                                    #:address ,address))))
           (eval
            `(begin
               (define-ns (target) ,name ,word)
               (define-ns (macro)  ,name
                 ,(case realm
                    ((code) `(scat: ',word compile))
                    ((data) `(scat: ',word literal))))))))
       words)
      ;; Read from dictionary.
      (for/list ((name (target-mapped-symbols)))
        (let ((word (find-target-word/false name)))     
          (list name
                (target-word-realm word)
                (target-word-address word))))))

;; Use a dict provided by (target-words) to perform a reverse lookup.
(define (reverse-lookup dict realm address)
  (prompt
   (for-each*
    (lambda (name r a)
      (when (and (eq? r realm)
                 (eq? a address))
        (abort name)))
    dict) #f))

(define (write-dict [port (current-output-port)])
  (pretty-print `(target-words ',(target-words)) port))
(define (save-dict filename)
  (with-output-to-file/safe filename
    (lambda () (write-dict))))
   
;; forth-load/compile just inlines the (forth-begin ..) macro. In
;; order for this to work it needs to be evaluated in the compiler
;; namespace.
(define (forth-load file)
  (eval `(forth-load/compile ,file)))

(snarf as-push (scat)
  ((x)         (tfind forth-load)))


;; Code garbage collection.

;; Instead of the incremental, 'dump all' model used in incremental.ss
;; it is also possible to perform whole-program reachability analysis
;; by constructing a serialized code graph from a number of entry
;; nodes (in case of a microcontroller: the reset + interrupt
;; vectors).

;; FIXME: this does require those vectors to be accessible using
;; names.