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

expander/flatten: better help, error reporting, and - mode for ++knot

Browse Source
This commit is contained in:
Matthew Flatt 2018-07-25 21:27:36 -06:00
parent a41f58f9d7
commit 0b9a7587f6
2 changed files with 19 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
racket/src/expander/extract/flatten.rkt
View File

@ -150,8 +150,11 @@
(cond
[(find-knot-tying-alternate knot-ties lnk (car external+local) linklets)
=> (lambda (alt-lnk)
(unless (eq? alt-lnk 'ignore)
(add-subst! alt-lnk external+local knot-ties)))]
(if (eq? alt-lnk 'ignore)
;; Map to original name:
(hash-set! substs (cdr external+local) (car external+local))
;; Map to alt-link:
(add-subst! alt-lnk external+local knot-ties)))]
[else
(hash-set! substs
(cdr external+local)
@ -180,7 +183,15 @@
'ignore]
[else
(define alt-lnk (link alt-path 0))
(define li (hash-ref linklets alt-lnk))
(define li (hash-ref linklets alt-lnk
(lambda ()
(error 'flatten
(string-append "module for knot tying is not part"
" of the flattened module's implementation\n"
" module: ~a\n"
" attempted redirect for: ~a")
(link-name alt-lnk)
(link-name lnk)))))
(define exports+locals (bootstrap:s-expr-linklet-exports+locals (linklet-info-linklet li)))
(for/or ([export+local (in-list exports+locals)])
(and (eq? external (car export+local))

9
racket/src/expander/run.rkt
View File

@ -108,19 +108,20 @@
[("-B") "Print extracted bootstrap as bytecode"
(set! extract-to-bytecode? #t)]
#:multi
[("++knot") sym path "Redirect imports from <sym> to flattened from <path>"
[("++knot") primitive-table path ("Redirect imports from #%<primitive-table> to flattened from <path>;"
" use `-` for <path> to leave as-is, effectively redirecting to a primitive use")
(hash-update! instance-knot-ties
(string->symbol (format "#%~a" sym))
(string->symbol (format "#%~a" primitive-table))
(lambda (l) (cons (if (equal? path "-")
'ignore
(path->complete-path (normal-case-path path)))
l))
null)]
[("++direct") primitive-table "Redirect imports from #%<primitive-table> to direct references"
[("++direct") primitive-table "Redirect from `(primitive-table '#%<primitive-table>)` to primitive use"
(hash-set! primitive-table-directs
(string->symbol (string-append "#%" primitive-table))
"")]
[("++direct-prefixed") primitive-table "Like ++direct, but prefixes with <primitive-table>:"
[("++direct-prefixed") primitive-table "Like ++direct, but prefix with <primitive-table>:"
(hash-set! primitive-table-directs
(string->symbol (string-append "#%" primitive-table))
(string-append primitive-table ":"))]