Add syntax property with static init-depend information to compound-unit/infer results
This commit is contained in:
parent
ddb683e1f2
commit
9b7e1767dd
|
@ -22,7 +22,8 @@
|
|||
map-sig split-requires split-requires* apply-mac complete-exports complete-imports check-duplicate-subs
|
||||
process-spec
|
||||
make-relative-introducer
|
||||
bind-at)
|
||||
bind-at
|
||||
build-init-depend-property)
|
||||
|
||||
(define-syntax (apply-mac stx)
|
||||
(syntax-case stx ()
|
||||
|
@ -594,3 +595,17 @@
|
|||
sstx
|
||||
(cons unbox-stx #'x)
|
||||
sstx)]))))
|
||||
|
||||
;; This utility function returns a list of natural numbers for use as a syntax
|
||||
;; property needed to support units in Typed Racket
|
||||
(define (build-init-depend-property init-depends imports)
|
||||
;; Typed Racket does not support tagged imports or exports
|
||||
;; so drop the tags from init-depends and imports
|
||||
(let ([id-sigs (map cdr init-depends)]
|
||||
[import-sigs (map cdr imports)])
|
||||
(let loop ([i 0] [imports import-sigs])
|
||||
(cond
|
||||
[(null? imports) '()]
|
||||
[else (if (member (car imports) id-sigs free-identifier=?)
|
||||
(cons i (loop (add1 i) (cdr imports)))
|
||||
(loop (add1 i) (cdr imports)))]))))
|
|
@ -1645,29 +1645,34 @@
|
|||
(syntax->list #'((((sub-in-key sub-in-code) ...) ...) ...))))
|
||||
)
|
||||
(values
|
||||
(quasisyntax/loc (error-syntax)
|
||||
(let ([deps '()]
|
||||
[sub-tmp sub-exp] ...)
|
||||
check-sub-exp ...
|
||||
(make-unit
|
||||
'name
|
||||
(vector-immutable
|
||||
(cons 'import-name
|
||||
(vector-immutable import-key ...))
|
||||
...)
|
||||
(vector-immutable
|
||||
(cons 'export-name
|
||||
(vector-immutable export-key ...))
|
||||
...)
|
||||
deps
|
||||
(lambda ()
|
||||
(let-values ([(sub-tmp sub-export-table-tmp) ((unit-go sub-tmp))]
|
||||
(syntax-property
|
||||
(quasisyntax/loc (error-syntax)
|
||||
(let ([deps '()]
|
||||
[sub-tmp sub-exp] ...)
|
||||
check-sub-exp ...
|
||||
(make-unit
|
||||
'name
|
||||
(vector-immutable
|
||||
(cons 'import-name
|
||||
(vector-immutable import-key ...))
|
||||
...)
|
||||
(vector-immutable
|
||||
(cons 'export-name
|
||||
(vector-immutable export-key ...))
|
||||
...)
|
||||
deps
|
||||
(lambda ()
|
||||
(let-values ([(sub-tmp sub-export-table-tmp) ((unit-go sub-tmp))]
|
||||
...)
|
||||
(values (lambda (import-table-id)
|
||||
(void)
|
||||
(sub-tmp (equal-hash-table sub-in-key-code-workaround ...))
|
||||
...)
|
||||
(values (lambda (import-table-id)
|
||||
(void)
|
||||
(sub-tmp (equal-hash-table sub-in-key-code-workaround ...))
|
||||
...)
|
||||
(unit-export ((export-key ...) export-code) ...)))))))
|
||||
(unit-export ((export-key ...) export-code) ...)))))))
|
||||
'tr:inferred-init-depend-property
|
||||
(build-init-depend-property
|
||||
static-dep-info
|
||||
(map syntax-e (syntax->list #'((import-tag . import-sigid) ...)))))
|
||||
(map syntax-e (syntax->list #'((import-tag . import-sigid) ...)))
|
||||
(map syntax-e (syntax->list #'((export-tag . export-sigid) ...)))
|
||||
static-dep-info))))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user