From 264a4a4ede845917315fcd706801c433fc378ee8 Mon Sep 17 00:00:00 2001 From: arthurmaciel Date: Tue, 13 Jun 2017 22:43:12 -0300 Subject: [PATCH] Added support for Cyclone to Snow --- lib/chibi/snow/commands.scm | 64 ++++++++++++++++++++++++++++++++++++- 1 file changed, 63 insertions(+), 1 deletion(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 974f51b4..ab31c4b4 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -6,6 +6,7 @@ (define known-implementations '((chibi "chibi-scheme" (chibi-scheme -V) "0.7.3") (chicken "chicken" (csi -p "(chicken-version)") "4.9.0") + (cyclone "cyclone" (icyc -vn) "0.5.3") (foment "foment") (gauche "gosh" (gosh -E "print (gauche-version)" -E exit) "0.9.4") (kawa "kawa" (kawa --version) "2.0") @@ -1306,6 +1307,13 @@ dir (make-path (or (conf-get cfg 'install-prefix)) "lib" impl (get-chicken-binary-version cfg)))))) + ((cyclone) + (let ((dir (let ((lib-path (get-environment-variable "CYCLONE_LIBRARY_PATH"))) + (if lib-path + (car (string-split lib-path #\:)) ; searches only in the first path set + (string-trim (process->string '(icyc -p "(Cyc-installation-dir 'sld)")) + char-whitespace?))))) + (list (or dir "/usr/local/share/cyclone/")))) ((gauche) (list (let ((dir (string-trim @@ -1347,6 +1355,7 @@ (path (or (find-in-path prog) prog)) (arg (case impl ((chicken) "-s") + ((cyclone) "-s") ((gauche) "-b") ((larceny) "-program") (else #f)))) @@ -1370,6 +1379,10 @@ (if lib-path `(csi -R r7rs -I ,install-dir -I ,lib-path -s ,file) `(csi -R r7rs -I ,install-dir -s ,file))) + ((cyclone) + (if lib-path + `(icyc -A ,install-dir -A ,lib-path -s ,file) + `(icyc -A ,install-dir -s ,file))) ((foment) (if lib-path `(foment -A ,install-dir -A ,lib-path ,file) @@ -1583,6 +1596,7 @@ (define (get-install-source-dir impl cfg) (cond ((eq? impl 'chicken) (get-install-library-dir impl cfg)) + ((eq? impl 'cyclone) (get-install-library-dir impl cfg)) ((conf-get cfg 'install-source-dir)) ((conf-get cfg 'install-prefix) => (lambda (prefix) (make-path prefix "share/snow" impl))) @@ -1591,6 +1605,7 @@ (define (get-install-data-dir impl cfg) (cond ((eq? impl 'chicken) (get-install-library-dir impl cfg)) + ((eq? impl 'cyclone) (get-install-library-dir impl cfg)) ((conf-get cfg 'install-data-dir)) ((conf-get cfg 'install-prefix) => (lambda (prefix) (make-path prefix "share/snow" impl))) @@ -1606,6 +1621,8 @@ (get-chicken-binary-version cfg)))) (else (car (get-install-dirs impl cfg))))) + ((eq? impl 'cyclone) + (car (get-install-dirs impl cfg))) ((conf-get cfg 'install-prefix) => (lambda (prefix) (make-path prefix "lib" impl))) (else (make-path "/usr/local/lib" impl)))) @@ -1754,15 +1771,31 @@ (install-file cfg (make-path dir imp-path) dest-imp-path) (list dest-so-path dest-imp-path))) +(define (cyclone-installer impl cfg library dir) + (let* ((library-file (get-library-file cfg library)) + (install-dir (get-install-library-dir impl cfg)) + (so-path (string-append (path-strip-extension library-file) ".so")) + (dest-so-path (make-path install-dir so-path)) + (o-path (string-append (path-strip-extension library-file) ".o")) + (dest-o-path (make-path install-dir o-path))) + (install-directory cfg (path-directory dest-so-path)) + (install-file cfg (make-path dir so-path) dest-so-path) + (install-file cfg (make-path dir o-path) dest-o-path) + (cons dest-o-path + (cons dest-so-path + (default-installer impl cfg library dir))))) + ;; installers should return the list of installed files (define (lookup-installer installer) (case installer ((chicken) chicken-installer) + ((cyclone) cyclone-installer) (else default-installer))) (define (installer-for-implementation impl cfg) (case impl ((chicken) 'chicken) + ((cyclone) 'cyclone) (else 'default))) (define (install-library impl cfg library dir) @@ -1913,15 +1946,30 @@ " - install anyway?")) library)))))) +(define (cyclone-builder impl cfg library dir) + (let* ((library-file (make-path dir (get-library-file cfg library))) + (so-path (make-path dir (string-append (path-strip-extension library-file) ".so")))) + (with-directory + dir + (lambda () + (let ((res (system 'cyclone '-o so-path + '-A (path-directory library-file) library-file))) + (and (or (and (pair? res) (zero? (cadr res))) + (yes-or-no? cfg "cyclone failed to build: " + (library-name library) + " - install anyway?")) + library)))))) + (define (lookup-builder builder) (case builder ((chibi) chibi-builder) ((chicken) chicken-builder) + ((cyclone) cyclone-builder) (else default-builder))) (define (builder-for-implementation impl cfg) (case impl - ((chibi chicken) impl) + ((chibi chicken cyclone) impl) (else 'default))) (define (build-library impl cfg library dir) @@ -1963,14 +2011,28 @@ path " - install anyway?")) prog)))))) +(define (cyclone-program-builder impl cfg prog dir) + (let ((path (get-program-file cfg prog))) + (with-directory + dir + (lambda () + (let ((res (system 'cyclone + '-A (path-directory path) path))) + (and (or (and (pair? res) (zero? (cadr res))) + (yes-or-no? cfg "cyclone failed to build: " + path " - install anyway?")) + prog)))))) + (define (lookup-program-builder builder) (case builder ((chicken) chicken-program-builder) + ((cyclone) cyclone-program-builder) (else default-program-builder))) (define (program-builder-for-implementation impl cfg) (case impl ((chicken) 'chicken) + ((cyclone) 'cyclone) (else 'default))) (define (build-program impl cfg prog dir)