batch-compile
This commit is contained in:
parent
ef7cea09bf
commit
534018e3a4
|
@ -1,8 +1,11 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide batch-compile)
|
||||||
|
|
||||||
(require "../main.rkt")
|
(require "../main.rkt")
|
||||||
(require "../reader.rkt")
|
(require "../reader.rkt")
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
|
(require racket/pretty)
|
||||||
(require (only-in racket/list index-of append-map remove-duplicates last drop-right))
|
(require (only-in racket/list index-of append-map remove-duplicates last drop-right))
|
||||||
(require (only-in racket/string string-split string-prefix?))
|
(require (only-in racket/string string-split string-prefix?))
|
||||||
(require (only-in racket/file make-parent-directory*))
|
(require (only-in racket/file make-parent-directory*))
|
||||||
|
@ -63,11 +66,43 @@
|
||||||
module-path
|
module-path
|
||||||
(file->schema full-input-path)))))
|
(file->schema full-input-path)))))
|
||||||
|
|
||||||
|
(define (batch-compile #:inputs inputs
|
||||||
|
#:additional-modules [additional-modules (hash)]
|
||||||
|
#:base-directory [base-directory #f]
|
||||||
|
#:output-directory [output-directory #f]
|
||||||
|
#:write-files? [write-files? #t])
|
||||||
|
(expand-globs inputs
|
||||||
|
base-directory
|
||||||
|
output-directory
|
||||||
|
(lambda (base-directory output-directory schemas)
|
||||||
|
|
||||||
|
(define index
|
||||||
|
(for/fold [(index additional-modules)]
|
||||||
|
[(s (in-list schemas))]
|
||||||
|
(hash-set index (schema-module-path s) (schema-relative-output-path s))))
|
||||||
|
|
||||||
|
(define outputs
|
||||||
|
(for/hash [(s (in-list schemas))]
|
||||||
|
(values (schema-full-output-path s)
|
||||||
|
(schema->module-stx (last (schema-module-path s))
|
||||||
|
(lambda (module-path)
|
||||||
|
(hash-ref index module-path #f))
|
||||||
|
(schema-value s)
|
||||||
|
#:filename (schema-full-output-path s)))))
|
||||||
|
|
||||||
|
(when write-files?
|
||||||
|
(for [((output-path stx) (in-hash outputs))]
|
||||||
|
(make-parent-directory* output-path)
|
||||||
|
(with-output-to-file output-path #:exists 'replace
|
||||||
|
(lambda () (pretty-write stx)))))
|
||||||
|
|
||||||
|
outputs)))
|
||||||
|
|
||||||
(module+ main
|
(module+ main
|
||||||
(require racket/cmdline)
|
(require racket/cmdline)
|
||||||
(require racket/pretty)
|
|
||||||
|
|
||||||
(define output-directory #f)
|
(define output-directory #f)
|
||||||
|
(define write-files? #t)
|
||||||
(define stdout? #f)
|
(define stdout? #f)
|
||||||
(define base-directory #f)
|
(define base-directory #f)
|
||||||
(define additional-modules '())
|
(define additional-modules '())
|
||||||
|
@ -78,6 +113,8 @@
|
||||||
(set! output-directory directory)]
|
(set! output-directory directory)]
|
||||||
["--stdout" "Prints each module to stdout one after the other instead of writing them to files in the `--output` directory"
|
["--stdout" "Prints each module to stdout one after the other instead of writing them to files in the `--output` directory"
|
||||||
(set! stdout? #t)]
|
(set! stdout? #t)]
|
||||||
|
["--no-write-files" "Disables generation of output to the filesystem"
|
||||||
|
(set! write-files? #f)]
|
||||||
["--base" directory "Base directory for sources (default: common prefix)"
|
["--base" directory "Base directory for sources (default: common prefix)"
|
||||||
(set! base-directory directory)]
|
(set! base-directory directory)]
|
||||||
#:multi
|
#:multi
|
||||||
|
@ -94,27 +131,21 @@
|
||||||
#:args input-glob
|
#:args input-glob
|
||||||
(set! inputs (map clean-input input-glob)))
|
(set! inputs (map clean-input input-glob)))
|
||||||
|
|
||||||
(expand-globs inputs
|
(when (null? inputs)
|
||||||
base-directory
|
(error 'preserves-schema-rkt "No inputs specified."))
|
||||||
output-directory
|
|
||||||
(lambda (base-directory output-directory schemas)
|
|
||||||
|
|
||||||
(define index (make-hash))
|
(define outputs
|
||||||
(for [(s (in-list schemas))]
|
(batch-compile #:inputs inputs
|
||||||
(hash-set! index (schema-module-path s) (schema-relative-output-path s)))
|
#:additional-modules (for/hash [(e (in-list additional-modules))]
|
||||||
(for [(e (in-list additional-modules))]
|
(values (car e) (cadr e)))
|
||||||
(hash-set! index (car e) (cadr e)))
|
#:base-directory base-directory
|
||||||
|
#:output-directory output-directory
|
||||||
|
#:write-files? write-files?))
|
||||||
|
|
||||||
(define outputs
|
(when stdout?
|
||||||
(for/hash [(s (in-list schemas))]
|
(for [((output-path stx) (in-hash outputs))]
|
||||||
(values (schema-full-output-path s)
|
(printf ";;-----------------------------------------------------------------\n")
|
||||||
(schema->module-stx (last (schema-module-path s))
|
(printf ";; ~a\n" output-path)
|
||||||
(lambda (module-path)
|
(newline)
|
||||||
(hash-ref index module-path #f))
|
(pretty-write stx)
|
||||||
(schema-value s)
|
(newline))))
|
||||||
#:filename (schema-full-output-path s)))))
|
|
||||||
|
|
||||||
(for [((output-path stx) (in-hash outputs))]
|
|
||||||
(make-parent-directory* output-path)
|
|
||||||
(with-output-to-file output-path #:exists 'replace
|
|
||||||
(lambda () (pretty-write stx)))))))
|
|
||||||
|
|
Loading…
Reference in New Issue