support dotcl

Makefile.am

@@ -77,7 +77,8 @@ LISPS = helper.el \
 	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-head.lisp \
-	install-cmu-bin.lisp install-ecl.lisp install-quicklisp.lisp \
+	install-cmu-bin.lisp install-dotcl-bin.lisp install-ecl.lisp \
+	install-quicklisp.lisp \
 	install-sbcl-bin.lisp install-sbcl.lisp install-sbcl-source.lisp \
 	install-sbcl-head.lisp \
 	install-slime.lisp install-sly.lisp \

lisp/install-dotcl-bin.lisp

@@ -0,0 +1,95 @@
+(roswell:include "util-install")
+(defpackage :roswell.install.dotcl-bin
+  (:use :cl :roswell.install :roswell.util :roswell.locations))
+(in-package :roswell.install.dotcl-bin)
+
+(defun dotcl-bin-impl ()
+  (merge-pathnames (format nil "impls/~A/~A/dotcl-bin/" (uname-m) (uname)) (homedir)))
+
+(defun dotcl-bin-rid ()
+  (let* ((arch (uname-m))
+         (os (uname))
+         (arch-key (cond ((equal arch "x86-64") "x64")
+                         ((equal arch "arm64") "arm64")
+                         (t (error "dotcl-bin: unsupported arch ~A" arch))))
+         (os-key (cond ((equal os "linux") "linux")
+                       ((equal os "darwin") "osx")
+                       ((equal os "windows") "win")
+                       (t (error "dotcl-bin: unsupported os ~A" os)))))
+    (format nil "~A-~A" os-key arch-key)))
+
+(defvar *dotcl-bin-version-cache* nil)
+
+(defun dotcl-bin-get-version ()
+  (or *dotcl-bin-version-cache*
+      (setf *dotcl-bin-version-cache*
+            (let ((file (merge-pathnames "tmp/dotcl-bin.json" (homedir))))
+              (format *error-output* "Checking version to install....~%")
+              (download "https://api.github.com/repos/dotcl/dotcl/releases" file)
+              (with-open-file (in file)
+                (loop for line = (read-line in nil nil) while line
+                      for pos = (search "\"tag_name\"" line)
+                      when pos
+                      collect (let* ((q1 (position #\" line :start (+ pos 11)))
+                                     (q2 (and q1 (position #\" line :start (1+ q1)))))
+                                (when (and q1 q2)
+                                  (let ((tag (subseq line (1+ q1) q2)))
+                                    (if (and (plusp (length tag)) (char= (aref tag 0) #\v))
+                                        (subseq tag 1)
+                                        tag))))))))))
+
+(defun dotcl-bin-argv-parse (argv)
+  (set-opt "prefix" (dotcl-bin-impl))
+  (cons t argv))
+
+(defun dotcl-bin-download (argv)
+  (let ((rid (dotcl-bin-rid))
+        (ver (version argv)))
+    (set-opt "as" ver)
+    (set-opt "download.uri"
+             (format nil "https://github.com/dotcl/dotcl/releases/download/v~A/dotcl-~A-~A.tar.bz2"
+                     ver rid ver))
+    (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")))))
+
+(defun dotcl-bin-expand (argv)
+  (format t "~%Extracting archive:~A~%" (opt "download.archive"))
+  (let ((dest (merge-pathnames (format nil "~A/" (opt "as")) (dotcl-bin-impl))))
+    (when (probe-file dest)
+      (uiop/filesystem:delete-directory-tree dest :validate t))
+    (ensure-directories-exist dest)
+    (expand (opt "download.archive") dest)
+    #-os-windows
+    (let ((apphost (merge-pathnames "runtime" dest)))
+      (when (probe-file apphost)
+        (uiop:run-program (list "chmod" "+x" (namestring apphost))
+                          :ignore-error-status t))))
+  (cons t argv))
+
+(defun dotcl-bin-script (argv)
+  (let* ((dotnet (which "dotnet"))
+         (dir (merge-pathnames (format nil "~A/" (opt "as")) (dotcl-bin-impl))))
+    (unless dotnet
+      (format *error-output* "Error: 'dotnet' (.NET SDK 10+) was not found in PATH.~%")
+      (format *error-output* "       Install .NET SDK 10 from https://dotnet.microsoft.com/download~%")
+      (format *error-output* "       'ros use dotcl-bin' will fail without dotnet.~%")
+      (roswell:quit 1))
+    (install-script
+     (merge-pathnames "dotcl" dir)
+     (format nil "exec \"~Aruntime\" \"$@\"" dir))
+    (cons t argv)))
+
+(defun dotcl-bin (type)
+  (case type
+    (:install `(,(decide-version 'dotcl-bin-get-version)
+                dotcl-bin-argv-parse
+                ,(decide-download 'dotcl-bin-download)
+                dotcl-bin-expand
+                dotcl-bin-script
+                setup))
+    (:list 'dotcl-bin-get-version)))

src/Makefile.am

@@ -32,7 +32,7 @@ ros_SOURCES = main.c opt.c download.c download_windows.c archive.c archive_windo
 	cmd-internal.c cmd-script.c \
 	cmd-run.c cmd-run-sbcl.c cmd-run-ccl.c cmd-run-clasp.c cmd-run-clisp.c cmd-run-ecl.c \
 	cmd-run-mkcl.c cmd-run-abcl.c cmd-run-cmu.c cmd-run-acl.c cmd-run-lispworks.c \
-	cmd-run-npt.c \
+	cmd-run-npt.c cmd-run-dotcl.c \
 	cmd-install.c install-sbcl-bin.c install-sbcl-bin_windows.c
 
 if WITH_WIN_ICON

src/cmd-run-dotcl.c

@@ -0,0 +1,45 @@
+#include "opt.h"
+
+char** cmd_run_dotcl(int argc,char** argv,struct sub_command* cmd) {
+  char* home=configdir();
+  char* arch=uname_m();
+  char* os=uname_s();
+  char* impl=(char*)cmd->name;
+  char* version=(char*)cmd->short_name;
+  /*[apphost binary] --eval init.lisp --eval (ros:run '(...)) [repl] */
+  int i;
+  char* impl_path=impldir(arch,os,impl, version);
+  char* help=get_opt("help",0);
+  char* script=get_opt("script",0);
+  char* program=get_opt("program",0);
+  char* dotcl_version=get_opt("version",0);
+  LVal ret=0;
+
+  s(arch),s(os);
+
+  ret=conss(cat(home,impl_path,DIRSEP,"runtime",EXE_EXTENTION,NULL),ret);
+
+  if(dotcl_version) {
+    ret=conss(q("--eval"),ret);
+    ret=conss(q("(progn (format t \"~A ~A~%\" (lisp-implementation-type) (lisp-implementation-version)) (dotcl:quit))"),ret);
+  }
+  ret=conss(q("--eval"),ret);
+  ret=conss(s_cat(q("(progn #-ros.init(cl:load \""),s_escape_string(lispdir()),q("init.lisp"),q("\"))"),NULL),ret);
+  ret=conss(q("--eval"),ret);
+  ret=conss(s_cat(q("(ros:run '("),q(program?program:""),
+                  script?cat("(:script ",script,")","(:quit ())",NULL):q(""),
+                  q("))"),NULL),ret);
+
+  /* dotcl exits after --eval/--load by default; for interactive (no script)
+     append the `repl` subcommand to keep the process alive. */
+  if(!script) {
+    ret=conss(q("repl"),ret);
+  }
+
+  for(i=1;i<argc;++i)
+    ret=conss(q(argv[i]),ret);
+
+  s(impl_path);
+  cond_printf(1,"\nhelp=%s script=%s\n",help?"t":"nil",script?script:"nil");
+  return stringlist_array(nreverse(ret));
+}

src/cmd-run.c

@@ -26,6 +26,8 @@ struct run_impl_t impls_to_run[]={
   {"lispworks",&cmd_run_lispworks},
   {"mkcl",&cmd_run_mkcl},
   {"npt",&cmd_run_npt},
+  {"dotcl",&cmd_run_dotcl},
+  {"dotcl-bin",&cmd_run_dotcl},
 };
 
 struct proc_opt run;

src/cmd-run.h

@@ -24,6 +24,7 @@ extern char** cmd_run_acl(int argc,char** argv,struct sub_command* cmd);
 extern char** cmd_run_lispworks(int argc,char** argv,struct sub_command* cmd);
 extern char** cmd_run_mkcl(int argc,char** argv,struct sub_command* cmd);
 extern char** cmd_run_npt(int argc,char** argv,struct sub_command* cmd);
+extern char** cmd_run_dotcl(int argc,char** argv,struct sub_command* cmd);
 extern struct proc_opt* register_runtime_options(struct proc_opt* cmd);
 int setup(char* target,char* env,char* impl);
 #define SETUP_SYSTEM(sys,msg) {\