WIP add --vfasl option

src/swish/swish-build

@@ -66,7 +66,25 @@
    [boot-files -b (list "<boot-file>")
     "make stand-alone program including <boot-file>"]
    [libs-visible --libs-visible bool
-    "make imported libraries visible to eval"]))
+    "make imported libraries visible to eval"]
+   [vfasl-convert --vfasl bool
+     `("try to make the compiled code load more quickly,"
+       "which may increase the size of the output file")]))
+
+(meta-cond
+ [(top-level-bound? 'vfasl-convert-file)
+  (define (maybe-vfasl target base-boots)
+    (when (opt 'vfasl-convert)
+      (let ([tmp-file (string-append target ".tmp")])
+        (on-exit (delete-file tmp-file)
+          (rename-path target tmp-file)
+          (vfasl-convert-file tmp-file target base-boots)))))]
+ [else
+  (define app-cli
+    (remp (lambda (x) (eq? (<arg-spec> name x) 'vfasl-convert))
+      app-cli))
+  (define (maybe-vfasl target base-boots)
+    (void))])
 
 (define swish-lib?
   (let ([libs (filter (lambda (lib) (match lib [(swish . ,_) #t] [,_ #f])) (library-list))])
@@ -700,11 +718,13 @@
           output-fn)
          (apply make-boot-file app-boot '()
            (append boot-files rt-libs other-libs (list output-fn)))
+         (maybe-vfasl app-boot '())
          (copy-file (osi_get_executable_path) output-fn))]
       [(component)
        (library-setup #f libdirs rt-libs)
        (resolve-missing-libs target-type rt-libs
          (do-compile source-fn output-fn #f target-type))
+       (maybe-vfasl output-fn #f)
        (show-files target-type #f #f rt-libs '() source-fn)]
       [(linked)
        (library-setup #f libdirs rt-libs)
@@ -721,6 +741,7 @@
                           (begin (file-position ip 0) #t)
                           (get-bytevector-exactly-n ip end)))))]
               [tmp (tmp-filename output-fn)]
+              [! (maybe-vfasl output-fn #f)]
               [ip (open-binary-file-to-read output-fn)]
               [op (open-file tmp (+ O_WRONLY O_CREAT O_TRUNC) #o777 'binary-output)])
          (define (cleanup) (close-port ip) (close-port op))

src/swish/swish-build.ms

@@ -217,7 +217,11 @@
   ;; fat with petite and scheme
   (write-example "fat2" hello-fat)
   (build-example "fat2" '("-b" "petite" "-b" "scheme"))
-  (run-fat "fat2" '() '("Hello, World!")))
+  (run-fat "fat2" '() '("Hello, World!"))
+  (when (top-level-bound? 'vfasl-convert-file)
+    (write-example "fat2v" hello-fat)
+    (build-example "fat2v" '("-b" "petite" "-b" "scheme" "--vfasl"))
+    (run-fat "fat2v" '() '("Hello, World!"))))
 
 (isolate-mat fat3 ()
   (define-environment-parameters SCHEMEHEAPDIRS)
@@ -258,7 +262,11 @@
        (swish imports))
       (printf "Hello, World!\n")))
   (build-example "thin" '())
-  (run-thin "thin" '() '("Hello, World!")))
+  (run-thin "thin" '() '("Hello, World!"))
+  (when (top-level-bound? 'vfasl-convert-file)
+    (write-example "thinv" `((printf "It worked\n")))
+    (build-example "thinv" '("--vfasl"))
+    (run-thin "thinv" '() '("It worked"))))
 
 (isolate-mat top-level-program ()
   (define tlp
@@ -872,6 +880,9 @@
             (printf "expect crash\n"))))))
   (define lib1.library (path-combine (output-dir) "lib1.library"))
   (define comp1.out (path-combine (output-dir) "comp1"))
+  (define comp1.outv
+    (and (top-level-bound? 'vfasl-convert-file)
+         (string-append comp1.out "v")))
   (define comp2.out (path-combine (output-dir) "comp2"))
   (define comp3.out (path-combine (output-dir) "comp3"))
   (define prog1 (output-file "prog1"))
@@ -899,6 +910,8 @@
   (swish-build-test `("-o" ,prog2 ,prog "-L" ,(output-dir) "--libs-visible") '())
   (swish-build-test `("-o" ,prog3 ,prog "-L" ,(output-dir) "--rtlib" ,lib1.library) '())
   (swish-build-test `("-c" "-o" ,comp1.out ,comp1 "-L" ,(output-dir)) '())
+  (when comp1.outv
+    (swish-build-test `("-c" "-o" ,comp1.outv ,comp1 "--vfasl" "-L" ,(output-dir)) '()))
   (swish-build-test `("-c" "-o" ,comp2.out ,comp1 "-L" ,(output-dir) "--rtlib" ,lib1.library) '())
   (swish-build-test `("-c" "-o" ,comp3.out ,comp1 "-L" ,(output-dir) "--libs-visible") '())
 
@@ -907,12 +920,18 @@
 
   ;; table created twice since prog1 and comp1 duplicate the code for lib1.ss
   (run-script prog1 `(,comp1.out) (map ->regexp !duplicated!))
+  (when comp1.outv
+    (run-script prog1 `(,comp1.outv) (map ->regexp !duplicated!)))
 
   ;; table created twice since prog2 and comp1 duplicate the code for lib1.ss
   (run-script prog2 `(,comp1.out) (map ->regexp !duplicated!))
+  (when comp1.outv
+    (run-script prog2 `(,comp1.outv) (map ->regexp !duplicated!)))
 
   ;; table created twice since prog3 and comp1 duplicate the code for lib1.ss
   (run-script prog3 `(,comp1.out) (map ->regexp !duplicated!))
+  (when comp1.outv
+    (run-script prog3 `(,comp1.outv) (map ->regexp !duplicated!)))
 
   ;; comp2 can't find say when loaded by prog1:
   ;;  - comp2 compiled with --rtlib lib1.library, so it doesn't include code for lib1