lang/reader.rkt
#lang racket/base
(require racket/port
         racket/list)

(provide (rename-out [my-read read]
                     [my-read-syntax read-syntax]))

;; my-read: input-port -> datum
(define (my-read in)
  (syntax->datum (my-read-syntax #f in)))


;; my-read-syntax: any input-port -> syntax
(define (my-read-syntax src in)
  (let* ([name (get-name-from-port in)]
         [port-content (port->string in)]
         [modules-to-compose (read-languages (open-input-string port-content))])
    (when (empty? modules-to-compose)
            (raise-syntax-error #f 
                          "The list of languages appears to be empty; I expected at least one"
                          (datum->syntax #f port-content (list src
                                                               1
                                                               0
                                                               1
                                                               (length port-content)))))
    (with-syntax ([name name]
                  [(module-to-compose ...) modules-to-compose])
      #'(module name racket/base
          
          (require module-to-compose ...)
          (provide (all-from-out module-to-compose) ...)))))

;; get-name-from-port: input-port -> symbol
;; Gets the implicit name of the module from the port.
(define (get-name-from-port port)
  (let* ([p-name (object-name port)]
         [name (if (path? p-name)
                   (let-values ([(base name dir?) (split-path p-name)])
                     (string->symbol
                      (path->string (path-replace-suffix name #""))))
                   'anonymous-module)])
    name))



;; read-languages: input-port -> (listof syntax)
;; Tries to read all the module names.
(define (read-languages ip)
  (let loop ()
    (let ([next-lang
           (read-syntax #f ip)])
      (cond
        [(eof-object? next-lang)
         empty]
        [else
         (cons next-lang (loop))]))))