suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add syntax property with static init-depend information to compound-unit/infer results

Browse Source
This commit is contained in:
Daniel Feltey 2015-08-25 17:01:04 -05:00 committed by Vincent St-Amour
parent ddb683e1f2
commit 9b7e1767dd
2 changed files with 43 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
racket/collects/racket/private/unit-compiletime.rkt
View File

@ -22,7 +22,8 @@
map-sig split-requires split-requires* apply-mac complete-exports complete-imports check-duplicate-subs map-sig split-requires split-requires* apply-mac complete-exports complete-imports check-duplicate-subs
process-spec process-spec
make-relative-introducer make-relative-introducer
bind-at) bind-at
build-init-depend-property)
(define-syntax (apply-mac stx) (define-syntax (apply-mac stx)
(syntax-case stx () (syntax-case stx ()
@ -594,3 +595,17 @@
sstx sstx
(cons unbox-stx #'x) (cons unbox-stx #'x)
sstx)])))) 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)))]))))

49
racket/collects/racket/unit.rkt
View File

@ -1645,29 +1645,34 @@
(syntax->list #'((((sub-in-key sub-in-code) ...) ...) ...)))) (syntax->list #'((((sub-in-key sub-in-code) ...) ...) ...))))
) )
(values (values
(quasisyntax/loc (error-syntax) (syntax-property
(let ([deps '()] (quasisyntax/loc (error-syntax)
[sub-tmp sub-exp] ...) (let ([deps '()]
check-sub-exp ... [sub-tmp sub-exp] ...)
(make-unit check-sub-exp ...
'name (make-unit
(vector-immutable 'name
(cons 'import-name (vector-immutable
(vector-immutable import-key ...)) (cons 'import-name
...) (vector-immutable import-key ...))
(vector-immutable ...)
(cons 'export-name (vector-immutable
(vector-immutable export-key ...)) (cons 'export-name
...) (vector-immutable export-key ...))
deps ...)
(lambda () deps
(let-values ([(sub-tmp sub-export-table-tmp) ((unit-go sub-tmp))] (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) (unit-export ((export-key ...) export-code) ...)))))))
(void) 'tr:inferred-init-depend-property
(sub-tmp (equal-hash-table sub-in-key-code-workaround ...)) (build-init-depend-property
...) static-dep-info
(unit-export ((export-key ...) export-code) ...))))))) (map syntax-e (syntax->list #'((import-tag . import-sigid) ...)))))
(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) ...))) (map syntax-e (syntax->list #'((export-tag . export-sigid) ...)))
static-dep-info)))))) static-dep-info))))))