From 1c18b41cd72300abf12d67abfd411f9edf2bcad9 Mon Sep 17 00:00:00 2001
From: Dimitri Fontaine <dim@tapoueh.org>
Date: Tue, 20 Nov 2018 22:59:43 +0100
Subject: [PATCH] Implement a new way of building pgloader: make save.

This time we directly call into the save-lisp-and-die feature of the
implementation. As pgloader only supports SBCL and CCL at the time being,
doing things without an abstraction layer is easy enough.

This needs more testing and a special version for the bundle case too. One
step at a time, etc.
---
 Makefile      |  3 +++
 src/save.lisp | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 73 insertions(+)
 create mode 100644 src/save.lisp

diff --git a/Makefile b/Makefile
index 06c381a..5708b8d 100644
--- a/Makefile
+++ b/Makefile
@@ -164,6 +164,9 @@ pgloader-standalone:
 test: $(PGLOADER)
 	$(MAKE) PGLOADER=$(realpath $(PGLOADER)) CL=$(CL) -C test regress
 
+save: ./src/save.lisp $(LISP_SRC)
+	sbcl --no-userinit --load ./src/save.lisp
+
 clean-bundle:
 	rm -rf $(BUNDLEDIR)
 	rm -rf $(BUNDLETESTD)/$(BUNDLENAME)/*
diff --git a/src/save.lisp b/src/save.lisp
new file mode 100644
index 0000000..3da0967
--- /dev/null
+++ b/src/save.lisp
@@ -0,0 +1,70 @@
+;;;
+;;; Create a build/bin/pgloader executable from the source code, using
+;;; Quicklisp to load pgloader and its dependencies.
+;;;
+
+(in-package #:cl-user)
+
+;; ccl provides an implementation of getenv already.
+#+sbcl
+(defun getenv (name &optional default)
+  "Return the current value for the environment variable NAME, or default
+   when unset."
+  (or (sb-ext:posix-getenv name) default))
+
+(require :asdf)                         ; should work in SBCL and CCL
+
+(defvar *quicklisp.lisp* "http://beta.quicklisp.org/quicklisp.lisp")
+
+(let* ((cwd        (uiop:getcwd))
+       (build-dir  (uiop:merge-pathnames* "build/" cwd))
+       (ql.lisp    (uiop:merge-pathnames* "quicklisp.lisp" build-dir))
+       (qldir      (uiop:merge-pathnames* "quicklisp/" build-dir))
+       (qlsetup    (uiop:merge-pathnames* "setup.lisp" qldir)))
+  ;;
+  ;; We might have to install Quicklisp in build/quicklisp
+  ;;
+  (unless (probe-file qlsetup)
+    (format t "File ~a is not found, installing Quicklisp from ~a~%"
+            qlsetup *quicklisp.lisp*)
+    (uiop:run-program (format nil "curl -o ~a ~a" ql.lisp *quicklisp.lisp*))
+    (load ql.lisp)
+    (let* ((quickstart (find-package "QUICKLISP-QUICKSTART"))
+           (ql-install (find-symbol "INSTALL" quickstart)))
+      (funcall ql-install :path qldir :proxy (getenv "http_proxy"))))
+
+  ;;
+  ;; Now that we have Quicklisp, load it and push our copy of pgloader in
+  ;; ql:*local-project-directories* where Quicklisp will find it.
+  ;;
+  (format t "Loading file ~a~%" qlsetup)
+  (load qlsetup)
+
+  (let* ((ql        (find-package "QL"))
+         (lpd       (find-symbol "*LOCAL-PROJECT-DIRECTORIES*" ql))
+         (quickload (find-symbol "QUICKLOAD" ql)))
+    (push cwd (symbol-value lpd))
+
+    ;;
+    ;; And finally load pgloader and its image-based hooks
+    ;;
+    (format t "Loading system pgloader~%")
+    (funcall quickload :pgloader)
+    (load (asdf:system-relative-pathname :pgloader "src/hooks.lisp"))))
+
+(defun pgloader-image-main ()
+  (let ((argv #+sbcl sb-ext:*posix-argv*
+              #+ccl ccl:*command-line-argument-list*))
+    (pgloader::main argv)))
+
+(let ((image-filename "/Users/dim/dev/pgloader/build/bin/pgloader"))
+  #+ccl
+  (ccl:save-application image-filename
+                        :toplevel-function #'cl-user::pgloader-image-main
+                        :prepend-kernel t)
+  #+sbcl
+  (sb-ext:save-lisp-and-die image-filename
+                            :toplevel #'cl-user::pgloader-image-main
+                            :executable t
+                            :save-runtime-options t
+                            :compression t))