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

cs: fill in recompile-linklet

Browse Source 
It doesn't do anything, but make it a conforming variant of the
identity function. Also, fill in checking for `compile-linklet`,
and correction documentation errors for `compile-linklet` and
`recompile-linklet`.
This commit is contained in:
Matthew Flatt 2019-03-05 16:34:43 -07:00
parent 85571bb542
commit a7988c3813
4 changed files with 94 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
pkgs/racket-doc/scribblings/reference/linklet.scrbl
View File

@ -120,7 +120,8 @@ otherwise.}
[name any/c #f]
[import-keys #f #f]
[get-import #f #f]
[options (listof (or/c 'serializable 'unsafe 'static 'use-prompt))
[options (listof (or/c 'serializable 'unsafe 'static
'use-prompt 'uninterned-literal))
'(serializable)])
linklet?]
[(compile-linklet [form (or/c correlated? any/c)]
@ -129,7 +130,8 @@ otherwise.}
[get-import (or/c #f (any/c . -> . (values (or/c linklet? instance? #f)
(or/c vector? #f))))
#f]
[options (listof (or/c 'serializable 'unsafe 'static 'use-prompt))
[options (listof (or/c 'serializable 'unsafe 'static
'use-prompt 'uninterned-literal))
'(serializable)])
(values linklet? vector?)])]{
@ -199,28 +201,37 @@ supplying @racket[#t] as the @racket[_use-prompt?] argument to
@racket[instantiate-linklet] may only wrap a prompt around the entire
instantiation.
If @racket['uninterned-literal] is included in @racket[options], then
literals in @racket[form] will not necessarily be interned via
@racket[datum-intern-literal] when compiling or loading the linklet.
Disabling the use of @racket[datum-intern-literal] can be especially
useful of the linklet includes a large string or byte string constant
that is not meant to be shared.
The symbols in @racket[options] must be distinct, otherwise
@exnraise[exn:fail:contract].
@history[#:changed "7.1.0.8" @elem{Added the @racket['no-prompt] option.}]}
@history[#:changed "7.1.0.8" @elem{Added the @racket['use-prompt] option.}
#:changed "7.1.0.10" @elem{Added the @racket['uninterned-literal] option.}]}
@defproc*[([(recompile-linklet [linklet linklet?]
[name any/c #f]
[import-keys #f #f]
[get-import (any/c . -> . (values (or/c linklet? #f)
(or/c vector? #f)))
(lambda (import-key) (values #f #f))]
[options (listof (or/c 'serializable 'unsafe 'static 'no-prompt))
[get-import #f #f]
[options (listof (or/c 'serializable 'unsafe 'static
'use-prompt 'uninterned-literal))
'(serializable)])
linklet?]
[(recompile-linklet [linklet linklet?]
[name any/c]
[import-keys vector?]
[get-import (any/c . -> . (values (or/c linklet? #f)
(or/c vector? #f)))
[get-import (or/c (any/c . -> . (values (or/c linklet? #f)
(or/c vector? #f)))
#f)
(lambda (import-key) (values #f #f))]
[options (listof (or/c 'serializable 'unsafe 'static 'no-prompt))
[options (listof (or/c 'serializable 'unsafe 'static
'use-prompt 'uninterned-literal))
'(serializable)])
(values linklet? vector?)])]{
@ -228,7 +239,8 @@ Like @racket[compile-linklet], but takes an already-compiled linklet
and potentially optimizes it further.
@history[#:changed "7.1.0.6" @elem{Added the @racket[options] argument.}
#:changed "7.1.0.8" @elem{Added the @racket['no-prompt] option.}]}
#:changed "7.1.0.8" @elem{Added the @racket['use-prompt] option.}
#:changed "7.1.0.10" @elem{Added the @racket['uninterned-literal] option.}]}
@defproc[(eval-linklet [linklet linklet?]) linklet?]{

4
racket/src/cs/Makefile
View File

@ -120,8 +120,10 @@ expander-rktl:
linklet-demo: $(BUILDDIR)linklet.$(CSO)
$(SCHEME) $(LINKLET_DEPS) $(BUILDDIR)linklet.$(CSO) demo/linklet.ss
LINKLET_SRCS = linklet/read.ss \
LINKLET_SRCS = linklet/version.ss \
linklet/read.ss \
linklet/write.ss \
linklet/check.ss \
linklet/performance.ss \
linklet/annotation.ss \
linklet/compress.ss \

34
racket/src/cs/linklet.sls
View File

@ -193,6 +193,7 @@
(correlated->annotation v))))))))
v]))
(include "linklet/check.ss")
(include "linklet/version.ss")
(include "linklet/write.ss")
(include "linklet/read.ss")
@ -420,7 +421,9 @@
;; indicated by the "ABI" (which is based on information about which
;; exports of an imported linklet are constants).
;; A linklet also has a table of information about its
;; A linklet also has a table of information about its exports. That
;; known-value information is used by schemify to perform
;; cross-linklet inlining and related optimizations.
(define-record-type linklet
(fields (mutable code) ; the procedure or interpretable form
@ -469,11 +472,12 @@
(define compile-linklet
(case-lambda
[(c) (compile-linklet c #f #f (lambda (key) (values #f #f)) '(serializable))]
[(c name) (compile-linklet c name #f (lambda (key) (values #f #f)) '(serializable))]
[(c name import-keys) (compile-linklet c name import-keys (lambda (key) (values #f #f)) '(serializable))]
[(c) (compile-linklet c #f #f #f '(serializable))]
[(c name) (compile-linklet c name #f #f '(serializable))]
[(c name import-keys) (compile-linklet c name import-keys #f '(serializable))]
[(c name import-keys get-import) (compile-linklet c name import-keys get-import '(serializable))]
[(c name import-keys get-import options)
(define check-result (check-compile-args 'compile-linklet import-keys get-import options))
(define serializable? (#%memq 'serializable options))
(define use-prompt? (#%memq 'use-prompt options))
(define cross-machine (and serializable?
@ -500,8 +504,10 @@
prim-knowns
;; Callback to get a specific linklet for a
;; given import:
(lambda (key)
(lookup-linklet-or-instance get-import key))
(if get-import
(lambda (key) (values #f #f #f))
(lambda (key)
(lookup-linklet-or-instance get-import key)))
import-keys))
(define impl-lam/lifts
(lift-in-schemified-linklet (show pre-lift-on? "pre-lift" impl-lam)))
@ -609,8 +615,20 @@
[else (values #f #f #f)]))]
[else (values #f #f #f)]))
(define (recompile-linklet lnk . args) lnk)
(define recompile-linklet
(case-lambda
[(lnk) (recompile-linklet lnk #f #f #f '(serializable))]
[(lnk name) (recompile-linklet lnk name #f #f '(serializable))]
[(lnk name import-keys) (recompile-linklet lnk name import-keys #f '(serializable))]
[(lnk name import-keys get-import) (recompile-linklet lnk name import-keys get-import '(serializable))]
[(lnk name import-keys get-import options)
(unless (linklet? lnk)
(raise-argument-error 'recompile-linklet "linklet?" lnk))
(check-compile-args 'recompile-linklet import-keys get-import options)
(if import-keys
(values lnk import-keys)
lnk)]))
;; Intended to speed up reuse of a linklet in exchange for not being
;; able to serialize anymore
(define (eval-linklet linklet)

42
racket/src/cs/linklet/check.ss Normal file
View File

@ -0,0 +1,42 @@
(define (check-compile-args who import-keys get-import orig-options)
(unless (or (not import-keys) (vector? import-keys))
(raise-argument-error who "(or/c #f vector?)" import-keys))
(unless (or (not get-import)
(and (procedure? get-import) (procedure-arity-includes? get-import 1)))
(raise-argument-error who "(or/c (procedure-arity-includes/c 1) #f)" get-import))
(when (and get-import (not import-keys))
(raise-arguments-error who
(string-append
"no vector supplied for import keys, but import-getting function provided;\n"
" the function argument must be `#f' when the vector argument is `#f'")
"import-getting function" get-import))
(let loop ([options orig-options]
[redundant #f]
[serializable #f]
[unsafe #f]
[static #f]
[use-prompt #f]
[uninterned-literal #f])
(cond
[(null? options)
(when redundant
(raise-arguments-error who "redundant option"
"redundant option" redundant
"supplied options" orig-options))]
[(pair? options)
(case (car options)
[(serializable)
(loop (cdr options) (or redundant serializable) 'serializable unsafe static use-prompt uninterned-literal)]
[(unsafe)
(loop (cdr options) (or redundant unsafe) serializable 'unsafe static use-prompt uninterned-literal)]
[(static)
(loop (cdr options) (or redundant static) serializable unsafe 'static use-prompt uninterned-literal)]
[(use-prompt)
(loop (cdr options) (or redundant use-prompt) serializable unsafe static 'use-prompt uninterned-literal)]
[(uninterned-literal)
(loop (cdr options) (or redundant uninterned-literal) serializable unsafe static use-prompt 'uninterned-literal)]
[else
(loop #f redundant serializable unsafe static use-prompt uninterned-literal)])]
[else
(raise-argument-error who "(listof/c 'serializable 'unsafe 'static 'use-prompt 'uninterned-literal)"
orig-options)])))