;; PROJECT

;; This manages the project state data for the interactive
;; compiler. The state contains:

;;    - scratch asm buffer
;;    - forth input stream log (per line)
;;    - dictionary state
;;    - project config: hooks + files


;; For clarity I'm using the convention to write write stateful words
;; on the left, and functional words on the right. This makes it
;; easier to understand words that perform complex state updates.


(module prj mzscheme
  (require "composite.ss"
           "ns-state-stx.ss"
           
           "badnop.ss"            ;; base word set
           "compiler.ss"          ;; macro word set
           "tethered.ss"          ;; distributed dev word set
           "compiler-commands.ss" ;; compile-mode commands
           "state.ss"
           "ns.ss"
           "list-utils.ss"
           "rpn-eval.ss"
           )

  (provide prj:)
  


  ;; (ns-new '(prj))
  (ns-state-stx (prj: badnop:)
                ((prj) (store) (state))
                ((badnop) (base)))

  (rpn-modules "prj.ss")


(compositions (prj) prj:


 ;; STATE
 
 (asm@      'asm @)    (asm!  'asm !)
 (dict@     'dict @)   (dict! 'dict !)

 (rcr       reverse cons reverse)
 (path!!    rcr !!)
 (path@@    rcr @@)

 (tset-data  dict@ swap3 dict-set-data dict!)
;; (defword   dict@ swap3 dict-shadow dict!)

 (>forth    'forth @ log-line 'forth !)

 
 (hook      '(hook) path@@    ;; retreive (compiled) hook code
            compile-badnop)

 ;; project files
 (var          @@ car)
 (prjfile      '(prj) var
               "/" string-append
               swap var string-append
               )

 
 ;; forth load path
 (prj-path     '(path) @@)
 
 
 (save-state    state '(file state) prjfile save-project)
 
;; (load-state!   read-file-first state!)
 
;; (revert-state       '(file state) prjfile load-state!)
;; (revert-init-state  '(file init-state) prjfile load-state!)
 

 ;; load a new project file
 ;; directory --
 (project-component  load-project
                     state! revert-macros)
 (project            'current project-component)  ;; most highlevel component (prj -> monitor -> init)

 ;; INTERPRETATION
 
 ;; target state (support for interactive.ss)

 ;; FIXME: abstract dictionary access

 (tfind-data  dict@ swap dict-find-data)
 (tfind       dict@ swap dict-find-code)  ;; returns word addresses! (byte for data mem)

 ;; FIXME: needs to do constants too.  actually, it should execute
 ;; macros too! why not? if it's possible to run a macro on an empty
 ;; buffer, and the result is a quoted value or program, it can be
 ;; executed. one more reason why macros should never have side
 ;; effects!

 (t            tinterpret)
 (tinterpret   dict@ dict-tinterpret)

 ;; symbol simulation --

 ;; Check if code is available on target. If so, run it, else run the
 ;; simulation code.
 
 (sim/target  (prj: dup dict@ swap dict-find/false not) dip/s
              (prj: tinterpret)    ifte/s)
              
 ; interpretation
 (tf          tfind 1 <<<)   ;; byte addresses
 (trun-ns     tf jsr)
 (trun        trun-ns sync)
 (tsee        dup symbol? (prj: tf) (prj:) ifte/s dasm)
 (ti          compile-int run/s)


 ;; COMPILATION

 ;; Loading/lexing a forth file and update macro cache + asm.
 
 (run>asm!      asm@ swap run asm!)  ;; consume a (compiled) macro
 (file>asm!     prj-path file/path->code/macro code/macro!)
 
 (string>asm!    string->code/macro code/macro!)
 (string/vm>asm! forth-string->syntax
                 vm->native/compile
                 forth->code/macro
                 code/macro!)
                 
 ;; store a list of macro definitions in the dictionary
 (macros!       ;; dup pp
                '(dict) @@ swap append '(dict) !!) ;

 
 (forth!        :macro run>asm!)               
                
 (code/macro!   dup (extend!) for-each  ;; update brood macro cache
                macros! forth!)
               
 (clear         '() asm!)                 ;; clear asm buffer



 ;; ASSEMBLY

 ;; Update the project dictionary using the current assembly and
 ;; dictionary state, and return binary code.
 
 (update!->bin bin/dict+@        ;; convert asm to binary
               dict!             ;; save the resulting dictionary
               clear             ;; clear the assembly buffer
               save-state)       ;; save the new state
 
 ;; Perform assembly from state. Don't write
 (bin/dict+@  asm@
              dict@    
                    asm/dict-post         ;; run post processing macros
                    asm/dict->bin/dict+)  ;; convert to binary


 (bin         bin/dict+@ drop p cr)
 (ppa         asm@
              dict@
                    asm/dict-post
                    drop reverse print-asm)



 ;; INITIALIZATION
 
 ;; Initialize the project from the monitor file. This writes out a
 ;; .hex file and updates the dictionary.

 (scrap-clear
    clear
    scrap-dict '(dict) !!)
;;    '()        '(macro) !!)

 (save-hex
    '(file hex) prjfile
    export-ihex)

 (load-project-component
     '(prj) var swap project-component)

 
 (scrap
    ;; scrap-clear
    ;; start from initial file
    'init load-project-component
  
    '(file monitor) prjfile   
    file>asm!

    bin/dict+@ dict! save-hex

    clear
    save-state
    "updated:" d cr
    space '(file state) prjfile d cr
    space '(file hex) prjfile d cr

    )


 ;; LIVE UPLOAD / ERASE
 
 ;; Perform assembly -> update state and and return binary code.

 (check-target identify dup '(id) var equal?
               (drop) ('incorrect-target 1-throw) ifte)
 
 ;; Live update
 (commit      update!->bin
              check-target
              upload)


 ;; mark current dictionary state
 (mark       dict@ 'mark push
             save-state)
 

 ;; install an application boot block
 (install     'application tfind 5 >>> erase-block  ;; erase previous
              clear
              '(install) :macro run>asm!
              commit)
              
 (empty-dict
             'mark pop
             '(mark-not-found) need  ;; FIXME
             dict!               ;; restore marked directory state
             'code tfind-data
             ceil-word->block
             'code tset-data)  ;; round to next block

 (_empty      check-target
             empty-dict
             'code tfind-data erase-from/w
             save-state)

 (empty        got-mark?
               (prj: _empty)
               ('(mark-not-found) throw) ifte/s)

 (got-mark?   'mark @ '() eq? not)
 
 (maybe-empty  got-mark?
               (prj: empty)
               (prj: "empty: no mark yet. first upload?\n" display)
               ifte/s)

 (empty-boot 0 erase-block)      ;; should always be safe

 (revert-macros  flush-dynamic-macros!  ;; kill em all
                 ;; '(macro) @@
                 '(dict) @@               ;; FIXME: this is probably wrong
                 (extend!) for-each)
 

 ;; VIEW

 (pa         asm@ reverse print-asm)    ;; print stored assembly
 (pdict      'dict @ print-dict)        ;; print stored dictionary
 (pwords     'dict @ print-words)
 (pbin       bin@ print-dict print-bin) ;; generate & print dict+binary
 (pforth     'forth @ reverse           ;; print stored forth log
             (d cr) for-each)

 (words      dict@ (car p) for-each cr)


 (dasm       dup 32 + '(point dasm) !!
             dup f! >>
             16 fwords>list swap
             dict@ disassemble
             print-asm)

 (more       '(point dasm) @@ dasm)



 
 ;; CONSOLE READ-EVAL-PRINT

 (with-io/s     '(port) @@ with-io-device/s)


 ;; These are toplevel evaluators which should throw decent
 ;; errors. Therefore they are wrapped in a run/error/s
 
 (rep-compile    (prj: string>asm!) run/error/s)
 (rep-compile/vm (prj: string/vm>asm!) run/error/s)
 
 (rep-live      (prj: dup >forth forth-string->syntax :live with-io/s) run/error/s)
 (rep-live/vm   (prj: dup >forth forth-string->syntax :live/vm with-io/s) run/error/s)

 
 
)


)