ref: c00462f5113944f00820efd86b826d970d0e718c
parent: a67b8fc67211b758279928351dc1348cfd565877
author: Matthew Flatt <mflatt@racket-lang.org>
date: Tue Nov 15 02:54:53 CST 2022
local/image.zuo: support embedding an image from a file Also, adjust the examples in "zuo.h" to clarify the interaction of new primitives and images.
--- a/local/image.zuo
+++ b/local/image.zuo
@@ -19,6 +19,9 @@
;;
;; * 'libs: list of module-path symbols; default is '(zuo)
;;
+;; * 'image-file: an existing image, causing 'libs to be ignored;
+;; default is #f
+;;
;; * 'deps: a file to record files reda to create the image; presence
;; along with non-#f 'output enables a potetial 'up-to-date result
;;
@@ -36,6 +39,8 @@
(hash-set cmd 'libs (cons (string->symbol module-path)
(hash-ref cmd 'libs '())))]
:once-each
+ [cmd "--image" file "Use <file> instead of creating a new image"
+ (hash-set cmd 'image-file file)]
[cmd "--deps" file "Write dependencies to <file>"
(hash-set cmd 'deps file)]
[cmd "--keep-collects" "Keep library collection path enabled"
@@ -72,9 +77,15 @@
(define deps-file (hash-ref cmd 'deps #f))
(define c-file (hash-ref cmd 'output #f))
-
+ (define image-file (hash-ref cmd 'image-file #f))
+
+ (when (and image-file (pair? given-libs))
+ (error "Don't provide both libraries and an image file"))
+
(when c-file
- (displayln (~a "generating " c-file " embedding these libraries: " (string-join (map ~s libs)))))
+ (if image-file
+ (displayln (~a "generating " c-file " embedding " (~s image-file)))
+ (displayln (~a "generating " c-file " embedding these libraries: " (string-join (map ~s libs))))))
(when deps-file
(display-to-file "" deps-file :truncate))
@@ -81,29 +92,36 @@
(define deps-h (and deps-file (cleanable-file deps-file)))
(define image
- (let ([ht (apply process
- (append
- (list (hash-ref (runtime-env) 'exe))
- (if deps-file
- (list "-M" deps-file)
- (list))
- (list "" (hash 'stdin 'pipe 'stdout 'pipe))))])
- (define p (hash-ref ht 'process))
- (define in (hash-ref ht 'stdin))
- (define out (hash-ref ht 'stdout))
- (fd-write in "#lang zuo/kernel\n")
- (fd-write in "(begin\n")
- (for-each (lambda (lib)
- (fd-write in (~a "(module->hash '" lib ")\n")))
- libs)
- (fd-write in "(dump-image-and-exit (fd-open-output 'stdout (hash))))\n")
- (fd-close in)
- (let ([image (fd-read out eof)])
- (fd-close out)
- (process-wait p)
- (unless (= 0 (process-status p))
- (error "image dump failed"))
- image)))
+ (cond
+ [image-file
+ (define in (fd-open-input image-file))
+ (define image (fd-read in eof))
+ (fd-close in)
+ image]
+ [else
+ (let ([ht (apply process
+ (append
+ (list (hash-ref (runtime-env) 'exe))
+ (if deps-file
+ (list "-M" deps-file)
+ (list))
+ (list "" (hash 'stdin 'pipe 'stdout 'pipe))))])
+ (define p (hash-ref ht 'process))
+ (define in (hash-ref ht 'stdin))
+ (define out (hash-ref ht 'stdout))
+ (fd-write in "#lang zuo/kernel\n")
+ (fd-write in "(begin\n")
+ (for-each (lambda (lib)
+ (fd-write in (~a "(module->hash '" lib ")\n")))
+ libs)
+ (fd-write in "(dump-image-and-exit (fd-open-output 'stdout (hash))))\n")
+ (fd-close in)
+ (let ([image (fd-read out eof)])
+ (fd-close out)
+ (process-wait p)
+ (unless (= 0 (process-status p))
+ (error "image dump failed"))
+ image))]))
(define zuo.c (fd-read (fd-open-input (at-source ".." "zuo.c")) eof))
(define out (if c-file
--- a/zuo.h
+++ b/zuo.h
@@ -24,13 +24,16 @@
/* ======================================================================== */
/*
- Startup step 1: initialize primitives, and maybe add your own.
+ Startup step 1: initialize primitives, and maybe add your own.
Any added primitives will appear in `kernel-env`, as well as being
- propagated as `zuo/kernel`, `zuo`, etc., initial imports. To ensure
- that images will work, primitives must be added in the same order,
- always, and imagines will only work in an environment with the same
- set of primitives.
+ propagated as `zuo/kernel`, `zuo`, etc., initial imports.
+
+ To ensure that images will work, primitives must be added in the
+ same order, always. Images will only work in an environment with
+ the same set of primitives, and using an iage without the
+ primitives will effectively remove them by using the image's
+ `kernel-env`.
*/
ZUO_EXPORT void zuo_ext_primitive_init();
@@ -117,8 +120,9 @@
#endif
/* ======================================================================== */
-/* Here's a simple example embedding application that makes an extra
- primitive `random-five` available: */
+/* Here's a example embedding application where the module is
+ implemented with `#lang zuo`, so we need to go through
+ `dynamic-require` to get provided values. */
#if 0
#include <stdio.h>
@@ -125,17 +129,15 @@
#include <string.h>
#include "zuo.h"
-static zuo_ext_t *random_five(zuo_ext_t *args) {- return zuo_ext_integer(5);
-}
+/* Link with a copy of "zuo.c" created by `zuo local/image.zuo` so
+ that the `zuo` module is available. */
int main() {- const char *prog = "#lang zuo/kernel (hash 'number (random-five))";
- zuo_ext_t *ht, *v;
+ const char *prog = "#lang zuo (provide main) (define (main) (+ 1 2))";
+ zuo_ext_t *ht, *dynamic_require, *main, *v;
/* Step 1 */
zuo_ext_primitive_init();
- zuo_ext_add_primitive(random_five, 1, "random-five");
/* Step 2 */
zuo_ext_image_init(NULL);
@@ -144,19 +146,25 @@
zuo_ext_runtime_init(zuo_ext_false(), zuo_ext_empty_hash());
/* Run `prog`: */
- ht = zuo_ext_eval_module(zuo_ext_symbol("five-app"), prog, strlen(prog));+ ht = zuo_ext_eval_module(zuo_ext_symbol("main-app"), prog, strlen(prog));- /* Inspect the result: */
- v = zuo_ext_hash_ref(ht, zuo_ext_symbol("number"), zuo_ext_false());- if (zuo_ext_apply(zuo_ext_hash_ref(zuo_ext_kernel_env(),
- zuo_ext_symbol("integer?"),- zuo_ext_false()),
- zuo_ext_cons(v, zuo_ext_null()))
- == zuo_ext_true())
- printf("The answer was %d\n", (int)zuo_ext_integer_value(v));- else
- printf("Something went wrong!\n");+ dynamic_require = zuo_ext_hash_ref(ht,
+ zuo_ext_symbol("dynamic-require"),+ zuo_ext_false());
+ main = zuo_ext_apply(dynamic_require,
+ zuo_ext_cons(zuo_ext_symbol("main-app"),+ zuo_ext_cons(zuo_ext_symbol("main"),+ zuo_ext_null())));
+
+ v = zuo_ext_apply(main, zuo_ext_null());
+
+ printf("%s\n",+ zuo_ext_string_ptr(zuo_ext_apply(zuo_ext_hash_ref(zuo_ext_kernel_env(),
+ zuo_ext_symbol("~s"),+ zuo_ext_false()),
+ zuo_ext_cons(v, zuo_ext_null()))));
+
return 0;
}
@@ -163,9 +171,10 @@
#endif
/* ======================================================================== */
-/* Here's a example embedding application that doesn't need a new
- primitive, but where the module is implemented with `#lang zuo`, so
- we need to go through `dynamic-require` to get provided values: */
+/* Here's an example embedding application that makes an extra
+ primitive `random-five` available. Beware that this example will not
+ work when using an embedded image, however, unless the image is one
+ generated by enabling the dump after step 3. */
#if 0
#include <stdio.h>
@@ -172,15 +181,17 @@
#include <string.h>
#include "zuo.h"
-/* Link with a copy of "zuo.c" created by `zuo local/image.zuo` so
- that the `zuo` module is available. */
+static zuo_ext_t *random_five(zuo_ext_t *args) {+ return zuo_ext_integer(5);
+}
int main() {- const char *prog = "#lang zuo (provide main) (define (main) (+ 1 2))";
- zuo_ext_t *ht, *dynamic_require, *main, *v;
+ const char *prog = "#lang zuo/kernel (hash 'number (random-five))";
+ zuo_ext_t *ht, *v;
/* Step 1 */
zuo_ext_primitive_init();
+ zuo_ext_add_primitive(random_five, 1, "random-five");
/* Step 2 */
zuo_ext_image_init(NULL);
@@ -188,25 +199,27 @@
/* Step 3 */
zuo_ext_runtime_init(zuo_ext_false(), zuo_ext_empty_hash());
+ if (0) {+ const char *dump = "#lang zuo/kernel (dump-image-and-exit (fd-open-output \"image\"))";
+ (void)zuo_ext_eval_module(zuo_ext_symbol("dump"), dump, strlen(dump));+ /* Afterward, use
+ zuo local/image.zuo --image image
+ to generate a ".c" file to link with this example. */
+ }
+
/* Run `prog`: */
- ht = zuo_ext_eval_module(zuo_ext_symbol("main-app"), prog, strlen(prog));+ ht = zuo_ext_eval_module(zuo_ext_symbol("five-app"), prog, strlen(prog));- dynamic_require = zuo_ext_hash_ref(ht,
- zuo_ext_symbol("dynamic-require"),- zuo_ext_false());
-
- main = zuo_ext_apply(dynamic_require,
- zuo_ext_cons(zuo_ext_symbol("main-app"),- zuo_ext_cons(zuo_ext_symbol("main"),- zuo_ext_null())));
-
- v = zuo_ext_apply(main, zuo_ext_null());
-
- printf("%s\n",- zuo_ext_string_ptr(zuo_ext_apply(zuo_ext_hash_ref(zuo_ext_kernel_env(),
- zuo_ext_symbol("~s"),- zuo_ext_false()),
- zuo_ext_cons(v, zuo_ext_null()))));
+ /* Inspect the result: */
+ v = zuo_ext_hash_ref(ht, zuo_ext_symbol("number"), zuo_ext_false());+ if (zuo_ext_apply(zuo_ext_hash_ref(zuo_ext_kernel_env(),
+ zuo_ext_symbol("integer?"),+ zuo_ext_false()),
+ zuo_ext_cons(v, zuo_ext_null()))
+ == zuo_ext_true())
+ printf("The answer was %d\n", (int)zuo_ext_integer_value(v));+ else
+ printf("Something went wrong!\n");return 0;
}