#lang scheme/base

;; The interactive code is decoupled from the compiler using a
;; namespace interface.  This module provides reflective operations on
;; this namespace.

;; Note that (some) target words are accessible through this
;; namespace, but we'll use the central repository to access them.
;; The namespace is mainly intended for hosting macros and debugging
;; + interaction functions.

(require
 scheme/pretty
 scheme/control
 scheme/match
 "../tools.ss"
 "../code.ss"
 "repl.ss"
 "../ns.ss"
 "../scat.ss"
 "../target.ss")

(provide (all-defined-out))


;; Code labels

(define (target-byte-addr address realm)
  ((eval 'target-byte-address) address realm))

(define (target-find sym)
  (match (code-find sym)
         (#f (error 'target-word-not-found "~s" sym))
         ((list name realm address)
          (values realm (target-byte-addr address realm)))))

(define (target-find-realm sym wanted-realm)
  (with-handlers ((void (lambda _ #f)))
    (let-values (((realm addr) (target-find sym)))
      (and (eq? realm wanted-realm) addr))))

(define (target-find-code sym)  (target-find-realm sym 'code))
(define (target-find-data sym)  (target-find-realm sym 'data))

;; Macro constants
(define (macro-constant . code)
  (eval `(with-handlers ((void (lambda _ #f)))
           (state->value
            ((macro: ,@code) (init-state))
            (ns (op ? qw))))))

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



;; 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!   ',(code-labels))
;;     (code-pointers-set!  ',(code-pointers))))


;; start console
(define (run [startup void])
  (dynamic-wind
    void
    (lambda ()
      (startup) 
      (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.


;; Load a dictionary file.  See staaplc.ss for an explanation of the
;; structure.

(define (read-dictionary [port (current-input-port)])
  (read-line port) ;; skip the #lang header
  (values (read) (read) (read)))

(define (load-dictionary file)
  (let-values (((info reqs init)
                (with-input-from-file file read-dictionary)))
    (eval info)
    (eval reqs)
    (eval init)))