;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; module-declarations.scm - Extend CHICKEN's built-in (declare ...)
;;; form with syntax for controlling modules.
;;;
;;;     (declare (module alphabet-soup)
;;;              (import abc def ghi)
;;;              (export uvw xyz))
;;;
;;; This file should be loaded as a compiler extension with the
;;; `-extend` flag to `csc`(1):
;;;
;;;     $ csc -extend module-declarations.scm <FILE>
;;;
;;; Copyright (c) 2014, Evan Hanson <evhan@foldling.org>
;;; BSD-style license. See LICENSE for details.
;;;

(import matchable srfi-1)

(define forms '())
(define module #f)
(define exports '())
(define imports '())

(define (walk-declaration e)
  (match e
    ((('module name) . rest)
     (set! module name)
     (walk-declaration rest))
    ((('export . names) . rest)
     (set! exports (append names exports))
     (walk-declaration rest))
    ((('import . names) . rest)
     (set! imports (append names imports))
     (walk-declaration rest))
    ((declaration . rest)
     (cons declaration (walk-declaration rest)))
    (else e)))

(define (walk-expression e)
  (match e
    (('declare . body)
     (let ((rest (walk-declaration body)))
       (cond ((null? rest)
              '(##core#undefined))
             (else
              (cons (car e) rest)))))
    ((a . d)
     ;; This oddness is just to preserve line number information.
     (let ((a* (walk-expression a))
           (d* (walk-expression d)))
       (cond ((and (eq? a* a) (eq? d* d)) e)
             (else (cons a* d*)))))
    (else e)))

(define (read-file/source-info f)
  (fluid-let ((##sys#current-source-filename f))
    (read-file f ##compiler#read/source-info)))

(user-read-pass
 (lambda (prelude files postlude)
   (let* ((forms    (map (compose walk-expression read-file/source-info) files))
          (prelude  (map (compose walk-expression ##compiler#string->expr) prelude))
          (postlude (map (compose walk-expression ##compiler#string->expr) postlude))
          (body     (cond (module
                           `((module ,module ()
                               (import scheme chicken)
                               ,@(map (lambda (i) `(use    ,i)) imports)
                               ,@(map (lambda (e) `(export ,e)) exports)
                               ,@(concatenate forms))))
                          (else
                           (concatenate forms)))))
       (append prelude body postlude))))