;;;;
;;;; rewrite.stk	-- ScmPkg package rewriting
;;;;
;;;; Copyright © 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@essi.fr]
;;;;    Creation date: 20-Mar-2007 15:13 (eg)
;;;; Last file update: 25-Apr-2007 18:19 (eg)
;;;;

(define *code-rewriters* '())

;; ----------------------------------------------------------------------
;;	add-rewriter! ...
;; ----------------------------------------------------------------------
(define (add-rewriter! lang proc)
  (set! *code-rewriters* (cons (cons lang proc) *code-rewriters*)))

;; ----------------------------------------------------------------------
;;	rewrite-package ...
;; ----------------------------------------------------------------------
(define (rewrite-package pkg dir)
  (let* ((name (package-name pkg))
	 (suff (package-suffix pkg))
	 (lang (car (package-language pkg)))
	 (rwt  (assoc lang *code-rewriters*)))
    (when rwt
      ;; Rewriting body
      (let ((src (make-path dir name (string-append name suff))))
	(when (> (stklos-pkg-verbosity) 0)
	  (eprintf "    - Rewriting package body for ~S\n" name))
	( (cdr rwt) src dir ))
      ;; Rewriting tests
      (let ((tst (make-path dir name "test" (string-append name "-test" suff))))
	(when (> (stklos-pkg-verbosity) 0)
	  (eprintf "    - Rewriting package tests for ~S\n" name))
	( (cdr rwt) tst dir )))))