syndicate-lang
/
preserves
mirror of https://gitlab.com/preserves/preserves.git
1
0
Fork 1
Code Releases Activity

Better import failure error reporting

This commit is contained in:
Tony Garnock-Jones 2021-05-26 23:27:55 +02:00
parent 5470497aa2
commit 87e816306d
3 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
implementations/racket/preserves/preserves-schema/bin/preserves-schema-rkt.rkt
View File

@ -110,13 +110,9 @@
(values (schema-full-output-path s) (values (schema-full-output-path s)
(schema->module-stx (last (schema-module-path s)) (schema->module-stx (last (schema-module-path s))
(lambda (module-path) (lambda (module-path)
(hash-ref index (hash-ref index module-path #f))
module-path (schema-value s)
(lambda () #:filename (schema-full-output-path s)))))
(error 'preserves-schema-rkt
"Undefined module: ~a"
module-path))))
(schema-value s)))))
(for [((output-path stx) (in-hash outputs))] (for [((output-path stx) (in-hash outputs))]
(make-parent-directory* output-path) (make-parent-directory* output-path)

20
implementations/racket/preserves/preserves-schema/compiler.rkt
View File

@ -25,7 +25,7 @@
(define (map-Schema-definitions proc schema) (define (map-Schema-definitions proc schema)
(fold-Schema-definitions (lambda (n p acc) (cons (proc n p) acc)) '() 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 imports (make-hash))
(define (import-ref! r) (define (import-ref! r)
(match-define (Ref module-path _name) r) (match-define (Ref module-path _name) r)
@ -61,7 +61,13 @@
[(EmbeddedTypeName-Ref r) (import-ref! r)]) [(EmbeddedTypeName-Ref r) (import-ref! r)])
(map-Schema-definitions (lambda (n p) (walk p)) schema) (map-Schema-definitions (lambda (n p) (walk p)) schema)
(for/list [(import (in-hash-keys imports))] (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) (define (embedded-defs schema)
(match (Schema-embeddedType schema) (match (Schema-embeddedType schema)
@ -104,11 +110,11 @@
(define (unparser-defs schema) (define (unparser-defs schema)
(map-Schema-definitions definition-unparser 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) (schema-check-problems! schema #:name name)
`(module ,name racket/base `(module ,name racket/base
(provide (all-defined-out)) (provide (all-defined-out))
,@(module-imports schema lookup-module-path) ,@(module-imports name schema lookup-module-path filename)
,@(embedded-defs schema) ,@(embedded-defs schema)
(require preserves) (require preserves)
(require preserves-schema/support) (require preserves-schema/support)
@ -127,9 +133,9 @@
(define-runtime-path schema-binary "../../../../schema/schema.bin") (define-runtime-path schema-binary "../../../../schema/schema.bin")
(define metaschema (parse-Schema (with-input-from-file schema-binary read-preserve))) (define metaschema (parse-Schema (with-input-from-file schema-binary read-preserve)))
(define metaschema-module-source (schema->module-stx 'gen-schema (define metaschema-module-source (schema->module-stx 'gen-schema
(lambda (module-path) (lambda (module-path) #f)
(error 'compiler-rkt-main "~a" module-path)) metaschema
metaschema)) #:filename schema-binary))
(if #t (if #t
(with-output-to-file "gen/schema.rkt" #:exists 'replace (with-output-to-file "gen/schema.rkt" #:exists 'replace

5
implementations/racket/preserves/preserves-schema/main.rkt
View File

@ -11,5 +11,6 @@
(define-values (_dirname filename _must-be-dir) (split-path src)) (define-values (_dirname filename _must-be-dir) (split-path src))
(schema->module-stx (schema->module-stx
(string->symbol (path->string (path-replace-extension filename ""))) (string->symbol (path->string (path-replace-extension filename "")))
(lambda (module-path) (error 'read-preserves-schema-module "~a" module-path)) (lambda (module-path) #f)
(port->schema src p)))) (port->schema src p)
#:filename src)))