;;;;;;;;;;;;;;;;;;;;
;/ Foresys engine functions
;;;;;;;;;;;;;;;;;;;;
(setq #:sys-package:colon '#:Foresys:engine)

(eval-when (load compile)

;/ inherit from session-var
(defstruct #:session-var:fsys
  ;/ a stack of symbol tables
  (st ())
)

)


;/ new version, no more ctedit, just the root
(defun :init (root name)
  (let ((session (#:session-var:fsys:make)))
    (#:TrfL:engine:init session root name)
    (#:session-var:funcenv1 session '#:Foresys:engine:upd-st-down)
    (#:session-var:funcenv2 session '#:Foresys:engine:upd-st-up)
    session)
)


;/ the first function to manage symbol tables
;/ this one is called when the tree is visited down
;/ it pushes a symbol table (when there is one)
(defun :upd-st-down (session-var tree)
  (let ((st (#:prim:get-symbol-table tree)))
    (when st (#:session-var:fsys:st session-var (cons st (#:session-var:fsys:st session-var)))))
)

;/ the second function to manage symbol tables
;/ this one is called when the tree is visited up
;/ it sets the top of the stack with the previous symbol table,
;/ when we meet a tree with a symbol table
(defun :upd-st-up (session-var tree)
  (let ((st (#:prim:get-symbol-table tree)))
    (when st (#:session-var:fsys:st session-var (cdr (#:session-var:fsys:st session-var)))))
)


;/ a sub class of transformer
(defstruct #:transformer:TrfL
)

;/ specific options are:
;/  - trans-name, the name of the TrfL module (it must be loaded before)
;/  - twalk, must be taken in one of (busm, bum, tdsm, tdm) where bu stands for bottom-up,
;/    td for top-down, sm for strictly monotonous and m for monotonous
;/  - mode, must be taken in one of (normal, match, action)
;/ if these values don't exist, the default options are busm normal
;/ for example: (#:Foresys:engine:transform-forlib 'CnesToul 
;/              (list (cons 'output-dir "/u3/users/croudet/tmp") 
;/              (cons 'trans-name 'LH) (cons 'no-report-check t)))
(defun :transform-forlib (forlib-name options)
  (let ((transformer (#:transformer:TrfL:make)))
    (transform-forlib transformer forlib-name options)
    )
)

;/ instantiation of the transform method
;/ calls the appropriate tree walk (according to options) on unit-tree
(defun #:transformer:TrfL:transform (transformer unit-tree)
  (let* ((options (#:transformer:options transformer))
         (trans-name (cassq 'trans-name options))
         (twalk (cassq 'twalk options))
         (mode (cassq 'mode options))
         ;; i have to test if trans-name exists
         ;; and we suppose that the module trans-name is loaded
         (session (#:Foresys:engine:init unit-tree trans-name)))
    (unless (memq mode '(normal action match))
 (setq mode 'normal))
    (unless (memq twalk '(busm bum tdsm tdm)) 
 (setq twalk 'busm))
    (selectq twalk
             (busm (#:TrfL:engine:bottom-up session mode ()))
             (bum (#:TrfL:engine:bottom-up session mode t))
             (tdsm (#:TrfL:engine:top-down session mode ()))
             (tdm (#:TrfL:engine:top-down session mode t)))
    )
)

(defun #:transformer:TrfL:end (transformer)
  ;;   ------------
  ;; exit from the lisp core executing the batch job  
  (print "terminated")
  ;;(#:foresys:end ())
  )