#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"
 "../code.ss"
 "repl.ss"
 "../ns.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)
   #t (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)))
    

;; Macro constants
(define (macro-constant . code)
  (eval `(state->value
          ((macro: ,@code) (init-state))
          (ns (op ? qw)))))


(define (target-mapped-symbols [prefix '(target)])
  (filter tfind/false (ns-mapped-symbols prefix)))

(define (target-words-set! words)
  ;; Write to dictionary.
  (for-each*
   (lambda (name realm address)
     (let ((word
            (eval
             `(new-target-word #:name ',name
                               #:realm ',realm
                               #:address ,address))))
       (eval
        `(begin
           (ns (target) (define ,name ,word))
           (ns (macro)  (define ,name
                          ,(case realm
                             ((code) `(scat: ',word compile))
                             ((data) `(scat: ',word literal)))))))))
   words))
  
  
(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))



;; Generate the project state file as an expression that can be
;; evaluated in a namespace containing this file.
(define (dict-snapshot)
  `(begin
     (target-words-set!   ',(target-words))
     (code-pointers-set!  ',(code-pointers))))

;; 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)))


;; start console
(define (run)
  (dynamic-wind
      void
      (lambda ()
        (repl (lambda (cmd)
                (eval `(forth-command ,cmd)))))
      (lambda ()
        ;; (printf "Closing console.\n")
        (eval '((tethered-close)))))) ;; pk2 needs proper shutdown


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