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)
(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)

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

@ -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

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

@ -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)))