#lang scheme/base
(require "../require.ss"
         scheme/match
         (planet bzlib/base) 
         ) ;; require-unify & provide-unify


(define (require-exp? exp) 
  (if (syntax? exp) 
      (require-exp? (syntax->datum exp))
      (match exp 
        ((list-rest 'require rest) 
         exp) 
        (else #f))))
;; (trace require-exp?)
(define (provide-exp? exp) 
  (if (syntax? exp) 
      (provide-exp? (syntax->datum exp))
      (match exp 
        ((list-rest 'provide rest) exp)
        (else #f))))

(define (transform-require exp) 
  (if (syntax? exp) 
      (require->require/unify exp) 
      (syntax->datum (transform-require (datum->syntax #f exp)))))
;; (trace transform-require)
(define (transform-provide exp)
  (if (syntax? exp)
      (provide->provide/unify exp) 
      (syntax->datum (transform-provide (datum->syntax #f exp)))))

(define (transform-body body) 
  (let ((reqs (map transform-require (filter require-exp? body)))
        (provs (map transform-provide (filter provide-exp? body)))
        (rest (filter (lambda (exp) 
                        (and (not (require-exp? exp)) 
                             (not (provide-exp? exp))))
                      body)))
    (append reqs rest provs)))
;; (trace transform-body)
(define (wrap in read) ;; can be called either as read or read-syntax... so we will have to pass in the syntax object!
  (let* ((body (transform-body (let loop ((acc '()))
                                 (let ((v (read in)))
                                   (if (eof-object? v)
                                       (reverse acc)
                                       (loop (cons v acc)))))))
         (path (object-name in))
         (name (if (path? path)
                   (let-values (((base name dir?)
                                 (split-path path)))
                     (string->symbol
                      (path->string
                       (path-replace-suffix name #""))))
                   'page)))
    (let ((module `(module ,name scheme/base
                     (require (planet bzlib/unify))
                     . ,body)))
      module)))

(define (m-read (in (current-input-port)))
  (wrap in read))

(define (m-read-syntax (src #f) (in (current-input-port)))
  (wrap in (lambda (in)
             (read-syntax src in))))

(provide (rename-out (m-read read)
                     (m-read-syntax read-syntax)))