preserves/implementations/racket/preserves/preserves-schema/main.rkt

36 lines
1.3 KiB
Racket

#lang racket/base
(provide (all-from-out "methods.rkt"))
(require "methods.rkt")
(module reader racket/base
(provide (rename-out [read-preserves-schema-module read-syntax]))
(require racket/match)
(require "compiler.rkt")
(require (only-in "reader.rkt" port->schema))
(require (only-in racket/port port->list))
(require (only-in "bin/preserves-schema-rkt.rkt" load-plugins))
(define (read-preserves-schema-module src [p (current-input-port)])
(define-values (_dirname filename _must-be-dir) (split-path src))
(define plugin-modules '())
(let loop ((params (port->list read (open-input-string (read-line p)))))
(match params
['()
(void)]
[(list* '#:plugin modname more)
(set! plugin-modules (cons modname plugin-modules))
(loop more)]
[other
(raise-syntax-error #f "Invalid #lang preserves-schema parameters: ~v" other)]))
(define plugins (load-plugins plugin-modules))
(schema->module-stx
(string->symbol (path->string (path-replace-extension filename "")))
(lambda (module-path) #f)
(port->schema src p)
#:plugins plugins
#:translation-paths (schema-translation-paths src
filename
#f
#f))))