Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-03 19:26:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Merging and fixing

Browse source
This commit is contained in:
retropikzel 2025-06-27 07:39:58 +03:00
commit dd00829a90
2 changed files with 34 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

86
lib/chibi/snow/commands.scm
View file

@ -1407,13 +1407,11 @@
"(begin (display (getenv \"LARCENY_ROOT\")) (exit))"))
char-whitespace?)
"lib/Snow")))
((racket)
(list (process->string
'(racket -e "(display (find-system-path 'collects-dir))"))))
((stklos)
(list (make-path
(process->string
'(stklos -e "(display (install-path #:libdir))")))))
((racket)
(list
(make-path
(process->string
'(racket -I racket/base -e "(display (find-system-path 'collects-dir))")))))
(else
(list (make-path (or (conf-get cfg 'install-prefix) "/usr/local")
"share/snow"
@ -1953,60 +1951,42 @@
(library-shared-include-files
impl cfg (make-path dir source-scm-file))))))))
;; Racket can only load files with .rkt suffix. So for each library we create
;; a file that sets language to r7rs and includes the .sld file
(define (racket-installer impl cfg library dir)
(let* ((library-file (get-library-file cfg library))
(rkt-file (path-replace-extension library-file "rkt"))
(library-file-name (path-strip-directory library-file))
(ext (get-library-extension impl cfg))
(dest-library-file
(string-append (library->path cfg library) "." ext))
(dest-rkt-file (path-replace-extension dest-library-file "rkt"))
(include-files
(library-include-files impl cfg (make-path dir library-file)))
(let* ((source-rkt-file
(string-append dir
"/"
(path-strip-extension (get-library-file cfg library))
".rkt"))
(install-dir (get-install-source-dir impl cfg))
(install-lib-dir (get-install-library-dir impl cfg)))
(dest-rkt-file
(string-append install-dir
"/"
(library->path cfg library) ".rkt"))
(path (make-path install-dir dest-rkt-file))
(include-filename (string-append
(path-strip-directory
(path-strip-extension path))
".sld")))
(display "HERE: ")
(display dir)
(display source-rkt-file)
(newline)
(display "HERE1: ")
(display rkt-file)
(display dest-rkt-file)
(newline)
;; Create .rkt file
(with-output-to-file
(string-append dir "/" rkt-file)
source-rkt-file
(lambda ()
(map display
`("#lang r7rs" #\newline
"(import (scheme base))" #\newline
"(include \"" ,library-file-name "\")" #\newline))))
;; install the library file
(let ((path (make-path install-dir dest-library-file))
(rkt-path (make-path install-dir dest-rkt-file)))
(install-directory cfg (path-directory path))
(install-file cfg (make-path dir library-file) path)
(install-file cfg (make-path dir rkt-file) rkt-path)
;; install any includes
(cons
path
(append
(map
(lambda (x)
(let ((dest-file (make-path install-dir (path-relative x dir))))
(install-directory cfg (path-directory dest-file))
(install-file cfg x dest-file)
dest-file))
include-files)
(map
(lambda (x)
(let* ((so-file (string-append x (cond-expand (macosx ".dylib")
(else ".so"))))
(dest-file (make-path install-lib-dir
(path-relative so-file dir))))
(install-directory cfg (path-directory dest-file))
(install-file cfg so-file dest-file)
dest-file))
(library-shared-include-files
impl cfg (make-path dir library-file))))))))
(list "#lang r7rs"
#\newline
"(import (scheme base))"
#\newline
"(include \"" include-filename "\")"
#\newline))))
(default-installer impl cfg library dir)
(install-file cfg source-rkt-file dest-rkt-file)))
;; installers should return the list of installed files
(define (lookup-installer installer)

1
lib/chibi/snow/utils.scm
View file

@ -70,6 +70,7 @@
(case impl
((chibi) (cond-expand (chibi #t) (else #f)))
((gauche) (cond-expand (gauche #t) (else #f)))
((racket) (cond-expand (racket #t) (else #f)))
((sagittarius) (cond-expand (sagittarius #t) (else #f)))
((stklos) (cond-expand (stklos #t) (else #f)))
(else #f)))