#lang scheme/base

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

(require
 scheme/pretty
 scheme/control
 scheme/match
 "../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))))

(define (set-target-words! 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))
  
  
;; Simple target dictionary read/write. This forgets assembly+binary code.
(define (target-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))

;; Since project files will contain arbitrary code anyway for maximal
;; flexibility, we don't bother with parsing and just generate code.


(define (write-dict [port (current-output-port)])
  (for-each
   pretty-print
   `(,@(eval '(macros))
     (words!    ',(target-words))
     (console!  ',(eval '(current-console)))
     (pointers! ',(eval '(pointers)))
     )))


(define (load-dict filename)
  (load filename))

(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.