;*=====================================================================*/
;*    serrano/prgm/project/bigloo/runtime/Eval/macro.scm               */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Thu Nov  3 08:59:04 1994                          */
;*    Last change :  Mon May  7 18:47:39 2001 (serrano)                */
;*    -------------------------------------------------------------    */
;*    La manipulation des macros (de l'interprete et du compilateur).  */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    Le module                                                        */
;*---------------------------------------------------------------------*/
(module __macro
   
   (export  (install-eval-expander     <keyword> <expander>)
	    (install-compiler-expander <keyword> <expander>)
	    (install-expander          <keyword> <expander>)
	    (get-eval-expander         <keyword>)
	    (get-compiler-expander     <keyword>))

   (import  __error
	    __hash)
   
   (use     __type
	    __bigloo
	    __tvector
	    __structure
	    __tvector
	    __bexit

	    __r4_numbers_6_5
	    __r4_numbers_6_5_fixnum
	    __r4_numbers_6_5_flonum
	    __r4_characters_6_6
	    __r4_equivalence_6_2
	    __r4_booleans_6_1
	    __r4_symbols_6_4
	    __r4_strings_6_7
	    __r4_pairs_and_lists_6_3
	    __r4_input_6_10_2
	    __r4_control_features_6_9
	    __r4_vectors_6_8
	    __r4_ports_6_10_1
	    __r4_output_6_10_3
	    
	    __evenv))

;*---------------------------------------------------------------------*/
;*    macro                                                            */
;*---------------------------------------------------------------------*/
(define-struct macros key eval-expander compiler-expander)

;*---------------------------------------------------------------------*/
;*    La table de hash commune aux deux espaces de macros.             */
;*---------------------------------------------------------------------*/
(define *macro-table* (make-hashtable))

;*---------------------------------------------------------------------*/
;*    install-eval-expander ...                                        */
;*    -------------------------------------------------------------    */
;*    On installe une macro pour l'interprete seulement.               */
;*---------------------------------------------------------------------*/
(define (install-eval-expander keyword expander)
   (cond
      ((not (symbol? keyword))
       (error "install-eval-expander" "Illegal expander keyword" keyword))
      ((not (procedure? expander))
       (error "install-eval-expander" "Illegal expander expander" expander))
      (else
       (let ((macro (hashtable-get *macro-table* keyword)))
	  (if (not (macros? macro))
	      (begin
		 (set! macro (macros keyword #f #f))
		 (hashtable-put! *macro-table* keyword macro)))
	  ;; on warn si la macro etait deja definie sous l'interprete
	  (if (macros-eval-expander macro)
	      (warning "install-eval-expander"
		       "Redefinition of expander -- "
		       keyword))
	  (macros-eval-expander-set! macro expander)))))

;*---------------------------------------------------------------------*/
;*    install-compiler-expander ...                                    */
;*    -------------------------------------------------------------    */
;*    On installe une macro pour le compilateur seulement.             */
;*---------------------------------------------------------------------*/
(define (install-compiler-expander keyword expander)
   (cond
      ((not (symbol? keyword))
       (error "install-eval-expander" "Illegal expander keyword" keyword))
      ((not (procedure? expander))
       (error "install-eval-expander" "Illegal expander expander" expander))
      (else
       (let ((macro (hashtable-get *macro-table* keyword)))
	  (if (not (macros? macro))
	      (begin
		 (set! macro (macros keyword #f #f))
		 (hashtable-put! *macro-table* keyword macro)))
	  ;; on warn si la macro etait deja definie sous le compilo
	  (if (macros-compiler-expander macro)
	      (warning "install-compiler-expander"
		       "Redefinition of expander -- "
		       keyword))
	  (macros-compiler-expander-set! macro expander)))))

;*---------------------------------------------------------------------*/
;*    install-expander ...                                             */
;*    -------------------------------------------------------------    */
;*    On installe une macro pour le compilateur *et* l'interprete.     */
;*---------------------------------------------------------------------*/
(define (install-expander keyword expander)
   (cond
      ((not (symbol? keyword))
       (error "install-eval-expander" "Illegal expander keyword" keyword))
      ((not (procedure? expander))
       (error "install-eval-expander" "Illegal expander expander" expander))
      (else
       (let ((macro (hashtable-get *macro-table* keyword)))
	  (if (not (macros? macro))
	      (begin
		 (set! macro (macros keyword #f #f))
		 (hashtable-put! *macro-table* keyword macro)))
	  ;; on warn si la macro etait deja definie sous l'interprete
	  (if (macros-eval-expander macro)
	      (warning "install-eval-expander"
		       "Redefinition of expander -- "
		       keyword))
	  ;; on warn si la macro etait deja definie sous le compilo
	  (if (macros-compiler-expander macro)
	      (warning "install-compiler-expander"
		       "Redefinition of expander -- "
		       keyword))
	  ;; on affecte
	  (macros-eval-expander-set! macro expander)
	  (macros-compiler-expander-set! macro expander)))))

;*---------------------------------------------------------------------*/
;*    get-eval-expander ...                                            */
;*    -------------------------------------------------------------    */
;*    On recupere une macro pour l'interprete.                         */
;*---------------------------------------------------------------------*/
(define (get-eval-expander keyword)
   (let ((macro (hashtable-get *macro-table* keyword)))
      (if (not (macros? macro))
	  #f
	  (macros-eval-expander macro))))

;*---------------------------------------------------------------------*/
;*    get-compiler-expander ...                                        */
;*    -------------------------------------------------------------    */
;*    On recupere une macro pour le compilateur.                       */
;*---------------------------------------------------------------------*/
(define (get-compiler-expander keyword)
   (let ((macro (hashtable-get *macro-table* keyword)))
      (if (not (macros? macro))
	  #f
	  (macros-compiler-expander macro))))



