#lang racket/base
(require racket/port
racket/list)
(provide (rename-out [my-read read]
[my-read-syntax read-syntax]))
(define (my-read in)
(syntax->datum (my-read-syntax #f in)))
(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) ...)))))
(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))
(define (read-languages ip)
(let loop ()
(let ([next-lang
(read-syntax #f ip)])
(cond
[(eof-object? next-lang)
empty]
[else
(cons next-lang (loop))]))))