From a7988c38130a9f2f7b6902330ba329c202b43693 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 5 Mar 2019 16:34:43 -0700 Subject: [PATCH] cs: fill in `recompile-linklet` 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`. --- .../scribblings/reference/linklet.scrbl | 34 ++++++++++----- racket/src/cs/Makefile | 4 +- racket/src/cs/linklet.sls | 34 +++++++++++---- racket/src/cs/linklet/check.ss | 42 +++++++++++++++++++ 4 files changed, 94 insertions(+), 20 deletions(-) create mode 100644 racket/src/cs/linklet/check.ss diff --git a/pkgs/racket-doc/scribblings/reference/linklet.scrbl b/pkgs/racket-doc/scribblings/reference/linklet.scrbl index 1832fcc067..8bb9b9cd1a 100644 --- a/pkgs/racket-doc/scribblings/reference/linklet.scrbl +++ b/pkgs/racket-doc/scribblings/reference/linklet.scrbl @@ -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?]{ diff --git a/racket/src/cs/Makefile b/racket/src/cs/Makefile index 77d341ac76..fca69204fe 100644 --- a/racket/src/cs/Makefile +++ b/racket/src/cs/Makefile @@ -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 \ diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index fc0b8c892f..df4bb6dccb 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -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) diff --git a/racket/src/cs/linklet/check.ss b/racket/src/cs/linklet/check.ss new file mode 100644 index 0000000000..6ea90b1ad8 --- /dev/null +++ b/racket/src/cs/linklet/check.ss @@ -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)])))