support ros install clisp-head (#495)

* clisp-head. tested on debian x86-64

* support locale for clisp 'ros -L clisp lang=german run' would be the way.

* tested on darwin. and notice warning.

* tested on alpine.

Makefile.am

@@ -67,7 +67,7 @@ LISPS = helper.el \
 	util-install.lisp util-install-quicklisp.lisp \
 	install+7zip.lisp install-abcl-bin.lisp install-allegro.lisp \
 	install-ccl-bin.lisp install-clasp-bin.lisp install-clasp.lisp \
-	install-clisp.lisp \
+	install-clisp.lisp install-clisp-head.lisp \
 	install-cmu-bin.lisp install-ecl.lisp install-quicklisp.lisp \
 	install-sbcl-bin.lisp install-sbcl.lisp install-sbcl-source.lisp \
 	install-sbcl-head.lisp \

lisp/install-clisp-head.lisp

@@ -0,0 +1,99 @@
+(roswell:include "util-install-quicklisp")
+(defpackage :roswell.install.clisp-head
+  (:use :cl :roswell.install :roswell.util :roswell.locations))
+(in-package :roswell.install.clisp-head)
+
+(defun clisp-head-variant ()
+  (let ((uname (uname))
+        (variant (opt "variant")))
+    (cond (variant variant)
+          ((and (equal uname "linux"))
+           "glibc2.19")
+          (t "")))) ;; TBD
+
+(defun clisp-head-get-version ()
+  (format *error-output* "Checking version to install....~%")
+  (let ((elts
+          (let ((file (merge-pathnames "tmp/clisp_head.tsv" (homedir))))
+            (download (clisp-head-version-uri) file :interval 3600)
+            (mapcar (lambda (x) (uiop:split-string x :separator '(#\tab)))
+                    (uiop:read-file-lines file))))
+        (uname (uname))
+        (uname-m (uname-m))
+        (variant (clisp-head-variant)))
+    (mapcar 'third (remove-if-not (lambda (x)
+                                    (and (equal (first x) uname)
+                                         (equal (second x) uname-m)
+                                         (equal (fourth x) variant)
+                                         ))
+                                  elts))))
+
+(defun clisp-head-argv-parse (argv)
+  (let ((uname (uname))
+        (uname-m (uname-m)))
+    (set-opt "as" (getf argv :version))
+    (set-opt "prefix" (merge-pathnames (format nil "impls/~A/~A/~A/~A/" (uname-m) (uname) (getf argv :target) (opt "as")) (homedir)))
+    (set-opt "src" (merge-pathnames (format nil "src/clisp-~A-~A-~A~A/"
+                                            (getf argv :version)
+                                            uname-m
+                                            uname
+                                            (let ((var (clisp-head-variant)))
+                                              (if (zerop (length var))
+                                                  ""
+                                                  (format nil "-~A" var))))
+                                    (homedir))))
+  (cons t argv))
+
+(defun clisp-head-download (argv)
+  (set-opt "download.uri" (format nil "~@{~A~}" (clisp-head-uri) (getf argv :version)
+                                  "/clisp-"
+                                  (getf argv :version) "-"
+                                  (uname-m) "-"
+                                  (uname)
+                                  (let ((var (clisp-head-variant)))
+                                    (if (zerop (length var))
+                                        ""
+                                        (format nil "-~A" var)))
+                                  "-binary"
+                                  #-win32 ".tar.bz2"
+                                  #+win32 ".msi"))
+  (set-opt "download.archive" (let ((pos (position #\/ (opt "download.uri") :from-end t)))
+                                (when pos
+                                  (merge-pathnames (format nil "archives/~A" (subseq (opt "download.uri") (1+ pos))) (homedir)))))
+  `((,(opt "download.archive") ,(opt "download.uri"))))
+
+#-win32
+(defun clisp-head-expand (argv)
+  (let ((impls (merge-pathnames (format nil "impls/~A/~A/clisp-head/" (uname-m) (uname)) (homedir))))
+    (cond
+      (t
+       (format t "~%Extracting archive:~A~%" (opt "download.archive"))
+       (expand (opt "download.archive")
+               (ensure-directories-exist impls))))
+    (ql-impl-util:rename-directory
+     (merge-pathnames (format nil "clisp-~A-~A-~A~A/"
+                              (opt "as")
+                              (uname-m)
+                              (uname)
+                              (let ((var (clisp-head-variant)))
+                                (if (zerop (length var))
+                                    ""
+                                    (format nil "-~A" var))))
+                      impls)
+     (merge-pathnames (format nil "~A/" (opt "as")) impls)))
+  (cons t argv))
+
+(defun clisp-head-help (argv)
+  (format t "no options for clisp-head~%")
+  (cons t argv))
+
+(defun clisp-head (type)
+  (case type
+    (:help '(clisp-head-help))
+    (:install `(,(decide-version 'clisp-head-get-version)
+                clisp-head-argv-parse
+                start
+                ,(decide-download 'clisp-head-download)
+                clisp-head-expand
+                setup))
+    (:list 'clisp-head-get-version)))

lisp/locations.lisp

@@ -15,6 +15,7 @@
        (push ',name *locations*))))
 
 (defuri clisp-version-uri "http://ftp.gnu.org/pub/gnu/clisp/release/")
+(defuri clisp-head-version-uri "https://github.com/roswell/clisp_head/releases/download/files/clisp_head.tsv")
 (defuri 7za-uri       "http://sourceforge.net/projects/sevenzip/files/7-Zip/9.20/7za920.zip/download#")
 (defuri allegro-uri   "ftp://ftp.franz.com/")
 (defuri abcl-bin-uri  "https://common-lisp.net/project/armedbear/releases/")
@@ -45,6 +46,7 @@
 (defuri ecl-uri  "https://github.com/roswell/ecl/archive/")
 (defuri sbcl-uri "https://github.com/sbcl/sbcl/archive/")
 (defuri sbcl-head-uri "https://github.com/roswell/sbcl_head/releases/download/")
+(defuri clisp-head-uri "https://github.com/roswell/clisp_head/releases/download/")
 (defuri npt-uri  "https://github.com/nptcl/npt/archive/")
 
 (defuri sbcl-bin-version-uri)

src/cmd-run-clisp.c

@@ -6,7 +6,7 @@ char** cmd_run_clisp(int argc,char** argv,struct sub_command* cmd) {
   char* os=uname_s();
   char* impl=(char*)cmd->name;
   char* version=(char*)cmd->short_name;
-  /*[binpath for clisp] -q -q -M param -repl init.lisp
+  /*[binpath for clisp] -q -q -M param -N locale-path [-L lang] -repl init.lisp
     [terminating NULL] that total 8 are default. */
   int i;
   char* impl_path=impldir(arch,os,impl,version);
@@ -14,6 +14,7 @@ char** cmd_run_clisp(int argc,char** argv,struct sub_command* cmd) {
   char* script=get_opt("script",0);
   char* image=get_opt("image",0);
   char* program=get_opt("program",0);
+  char* lang=get_opt("lang",0);
   int simple=0;
   LVal ret=0;
 
@@ -45,6 +46,18 @@ char** cmd_run_clisp(int argc,char** argv,struct sub_command* cmd) {
       ret=conss(path,ret);
     }
   }
+  {
+    char* path=cat(basedir(),impl_path,SLASH,"share",SLASH,"locale",SLASH,NULL);
+    cond_printf(1,"localedir=%s\n",path);
+    ret=conss(q("-N"),ret);
+    ret=conss(path,ret);
+  }
+  if(lang) {
+    cond_printf(1,"lang=%s\n",lang);
+    ret=conss(q("-L"),ret);
+    ret=conss(q(lang),ret);
+  }
+
   if(image) {
     char *path=cat(basedir(),impl_path,SLASH,"dump",SLASH,image,".core",NULL);
     if(file_exist_p(path)) {

src/cmd-run.c

@@ -12,6 +12,7 @@ struct run_impl_t impls_to_run[]={
   {"ccl32",&cmd_run_ccl},
   {"clasp",&cmd_run_clasp},
   {"clasp-bin",&cmd_run_clasp},
+  {"clisp-head",&cmd_run_clisp},
   {"clisp",&cmd_run_clisp},
   {"clisp32",&cmd_run_clisp},
   {"ecl",&cmd_run_ecl},