forked from syndicate-lang/preserves
Better import failure error reporting
This commit is contained in:
parent
5470497aa2
commit
87e816306d
|
@ -110,13 +110,9 @@
|
|||
(values (schema-full-output-path s)
|
||||
(schema->module-stx (last (schema-module-path s))
|
||||
(lambda (module-path)
|
||||
(hash-ref index
|
||||
module-path
|
||||
(lambda ()
|
||||
(error 'preserves-schema-rkt
|
||||
"Undefined module: ~a"
|
||||
module-path))))
|
||||
(schema-value s)))))
|
||||
(hash-ref index module-path #f))
|
||||
(schema-value s)
|
||||
#:filename (schema-full-output-path s)))))
|
||||
|
||||
(for [((output-path stx) (in-hash outputs))]
|
||||
(make-parent-directory* output-path)
|
||||
|
|
|
@ -25,7 +25,7 @@
|
|||
(define (map-Schema-definitions proc schema)
|
||||
(fold-Schema-definitions (lambda (n p acc) (cons (proc n p) acc)) '() schema))
|
||||
|
||||
(define (module-imports schema lookup-module-path)
|
||||
(define (module-imports name schema lookup-module-path filename)
|
||||
(define imports (make-hash))
|
||||
(define (import-ref! r)
|
||||
(match-define (Ref module-path _name) r)
|
||||
|
@ -61,7 +61,13 @@
|
|||
[(EmbeddedTypeName-Ref r) (import-ref! r)])
|
||||
(map-Schema-definitions (lambda (n p) (walk p)) schema)
|
||||
(for/list [(import (in-hash-keys imports))]
|
||||
`(require (prefix-in ,(module-path-prefix import) ,(lookup-module-path import)))))
|
||||
(match (lookup-module-path import)
|
||||
[#f (error 'module-imports
|
||||
"Reference to unknown module ~a in module ~a~a"
|
||||
(string-join (map symbol->string import) ".")
|
||||
name
|
||||
(if filename (format " (~a)" filename) ""))]
|
||||
[path `(require (prefix-in ,(module-path-prefix import) ,path))])))
|
||||
|
||||
(define (embedded-defs schema)
|
||||
(match (Schema-embeddedType schema)
|
||||
|
@ -104,11 +110,11 @@
|
|||
(define (unparser-defs schema)
|
||||
(map-Schema-definitions definition-unparser schema))
|
||||
|
||||
(define (schema->module-stx name lookup-module-path schema)
|
||||
(define (schema->module-stx name lookup-module-path schema #:filename [filename #f])
|
||||
(schema-check-problems! schema #:name name)
|
||||
`(module ,name racket/base
|
||||
(provide (all-defined-out))
|
||||
,@(module-imports schema lookup-module-path)
|
||||
,@(module-imports name schema lookup-module-path filename)
|
||||
,@(embedded-defs schema)
|
||||
(require preserves)
|
||||
(require preserves-schema/support)
|
||||
|
@ -127,9 +133,9 @@
|
|||
(define-runtime-path schema-binary "../../../../schema/schema.bin")
|
||||
(define metaschema (parse-Schema (with-input-from-file schema-binary read-preserve)))
|
||||
(define metaschema-module-source (schema->module-stx 'gen-schema
|
||||
(lambda (module-path)
|
||||
(error 'compiler-rkt-main "~a" module-path))
|
||||
metaschema))
|
||||
(lambda (module-path) #f)
|
||||
metaschema
|
||||
#:filename schema-binary))
|
||||
|
||||
(if #t
|
||||
(with-output-to-file "gen/schema.rkt" #:exists 'replace
|
||||
|
|
|
@ -11,5 +11,6 @@
|
|||
(define-values (_dirname filename _must-be-dir) (split-path src))
|
||||
(schema->module-stx
|
||||
(string->symbol (path->string (path-replace-extension filename "")))
|
||||
(lambda (module-path) (error 'read-preserves-schema-module "~a" module-path))
|
||||
(port->schema src p))))
|
||||
(lambda (module-path) #f)
|
||||
(port->schema src p)
|
||||
#:filename src)))
|
||||
|
|
Loading…
Reference in New Issue