Clean up code
This commit is contained in:
parent
6459c6e149
commit
49503db2c6
33
Makefile
33
Makefile
|
|
@ -1,3 +1,4 @@
|
|||
.SILENT: test-r6rs test-r6rs-docker test-r7rs test-r7rs-docker
|
||||
PREFIX=/usr/local
|
||||
SCHEME=chibi
|
||||
VERSION=1.0.0
|
||||
|
|
@ -100,26 +101,14 @@ test-r6rs:
|
|||
rm -rf ${R6RSTMP}
|
||||
mkdir -p ${R6RSTMP}
|
||||
cp -r r6rs-testfiles/* ${R6RSTMP}/
|
||||
cd ${R6RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -I ./libs -o main main.sps
|
||||
cd ${R6RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -I ./libs -o main --debug main.sps
|
||||
cd ${R6RSTMP} && ./main 1 2 3 > test-result.txt
|
||||
@grep "Test successfull (\"1\" \"2\" \"3\")" ${R6RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R6RSTMP}/test-result.txt && exit 1)
|
||||
|
||||
test-r6rs-docker:
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} --quiet . > /dev/null
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r6rs"
|
||||
|
||||
test-r6rs-php:
|
||||
rm -rf ${R6RSTMP}
|
||||
mkdir -p ${R6RSTMP}
|
||||
cp -r r6rs-php-testfiles/* ${R6RSTMP}/
|
||||
cd ${R6RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -t php -o main.php main.sps
|
||||
-cd ${R6RSTMP} && php main.php > test-result.txt 2>&1
|
||||
@grep "Test successfull" ${R6RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R6RSTMP}/test-result.txt && exit 1)
|
||||
|
||||
test-r6rs-php-docker:
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r6rs-php"
|
||||
|
||||
test-r7rs:
|
||||
rm -rf ${R7RSTMP}
|
||||
mkdir -p ${R7RSTMP}
|
||||
|
|
@ -129,7 +118,7 @@ test-r7rs:
|
|||
@grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
|
||||
|
||||
test-r7rs-docker:
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} --quiet . > /dev/null
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs"
|
||||
|
||||
test-r7rs-wine:
|
||||
|
|
@ -141,20 +130,8 @@ test-r7rs-wine:
|
|||
@grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
|
||||
|
||||
test-r7rs-wine-docker:
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} --quiet . > /dev/null
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs-wine"
|
||||
|
||||
test-r7rs-php:
|
||||
rm -rf ${R7RSTMP}
|
||||
mkdir -p ${R7RSTMP}
|
||||
cp -r r7rs-php-testfiles/* ${R7RSTMP}/
|
||||
cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} COMPILE_R7RS_TARGET=php compile-scheme -o main.php main.scm
|
||||
-cd ${R7RSTMP} && php main.php > test-result.txt 2>&1
|
||||
@grep "Test successfull" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
|
||||
|
||||
test-r7rs-php-docker:
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs-php"
|
||||
|
||||
clean:
|
||||
git clean -X -f
|
||||
|
|
|
|||
|
|
@ -8,7 +8,11 @@
|
|||
(libs library-util)
|
||||
(srfi 170))
|
||||
|
||||
(define debug? (if (member "--debug" (command-line)) #t #f))
|
||||
(define debug?
|
||||
(if (or (member "--debug" (command-line))
|
||||
(get-environment-variable "SCHEME_COMPILE_DEBUG"))
|
||||
#t
|
||||
#f))
|
||||
|
||||
(when (member "--help" (command-line))
|
||||
(display "For help see: man compile-scheme")
|
||||
|
|
@ -67,10 +71,12 @@
|
|||
((get-environment-variable "COMPILE_SCHEME")
|
||||
(string->symbol (get-environment-variable "COMPILE_SCHEME")))
|
||||
(else #f)))
|
||||
|
||||
(when (not scheme)
|
||||
(display "Either environment variable COMPILE_R7RS or COMPILE_SCHEME is not set." (current-error-port))
|
||||
(newline (current-error-port))
|
||||
(exit 1))
|
||||
|
||||
(when (not (assoc scheme data)) (error "Unsupported implementation" scheme))
|
||||
|
||||
(define input-file
|
||||
|
|
@ -163,42 +169,14 @@
|
|||
(newline)
|
||||
(exit 0))
|
||||
|
||||
#;(define search-library-files
|
||||
(lambda (directory)
|
||||
(let ((result (list)))
|
||||
(for-each
|
||||
(lambda (file)
|
||||
(let* ((path (string-append directory "/" file))
|
||||
(info (file-info path #f)))
|
||||
(when (and (not r6rs?)
|
||||
(string-ends-with? path ".sld"))
|
||||
(set! result (append result (list path))))
|
||||
(when (and r6rs?
|
||||
(string-ends-with? path ".sls"))
|
||||
(set! result (append result (list path))))
|
||||
(if (file-info-directory? info)
|
||||
(set! result (append result (search-library-files path))))))
|
||||
(directory-files directory))
|
||||
result)))
|
||||
|
||||
#;(define library-files
|
||||
(cond (single-library-input-file (list single-library-input-file))
|
||||
(else
|
||||
(apply append
|
||||
(map
|
||||
(lambda (directory)
|
||||
(if (file-exists? directory)
|
||||
(search-library-files directory)
|
||||
(list)))
|
||||
(append prepend-directories append-directories))))))
|
||||
|
||||
(define library-files (library-dependencies scheme
|
||||
(append prepend-directories append-directories)
|
||||
(if input-file
|
||||
input-file
|
||||
single-library-input-file)
|
||||
(list)
|
||||
(list)))
|
||||
(define library-files
|
||||
(library-dependencies scheme
|
||||
(append prepend-directories append-directories)
|
||||
(if input-file
|
||||
input-file
|
||||
single-library-input-file)
|
||||
(list)
|
||||
(list)))
|
||||
|
||||
(define scheme-command
|
||||
(apply (cdr (assoc 'command (cdr (assoc scheme data))))
|
||||
|
|
@ -220,22 +198,11 @@
|
|||
r6rs?
|
||||
compilation-target)))
|
||||
|
||||
(when debug?
|
||||
(display "[debug] scheme-command: ")
|
||||
(write scheme-command)
|
||||
(newline))
|
||||
|
||||
(define scheme-library-command
|
||||
(lambda (library-file)
|
||||
(apply (cdr (assoc 'library-command (cdr (assoc scheme data))))
|
||||
(list library-file prepend-directories append-directories r6rs?))))
|
||||
|
||||
(when debug?
|
||||
(display "[debug] scheme-library-command: ")
|
||||
(write scheme-library-command)
|
||||
(newline))
|
||||
|
||||
|
||||
(define list-of-features
|
||||
(letrec ((looper (lambda (rest result)
|
||||
(if (null? rest)
|
||||
|
|
@ -249,16 +216,25 @@
|
|||
|
||||
(when (not (null? library-files))
|
||||
(when (assoc 'library-command (cdr (assoc scheme data)))
|
||||
(for-each
|
||||
(lambda (file)
|
||||
(let* ((library-command (scheme-library-command file)))
|
||||
(for-each
|
||||
(lambda (command)
|
||||
(let ((exit-code (system command)))
|
||||
(when (not (= exit-code 0))
|
||||
(exit exit-code))))
|
||||
library-command)))
|
||||
library-files)))
|
||||
(for-each
|
||||
(lambda (file)
|
||||
(let* ((library-command (scheme-library-command file)))
|
||||
(when debug?
|
||||
(display "[DEBUG] library-command: ")
|
||||
(write library-command)
|
||||
(newline))
|
||||
(for-each
|
||||
(lambda (command)
|
||||
(let ((exit-code (system command)))
|
||||
(when (not (= exit-code 0))
|
||||
(exit exit-code))))
|
||||
library-command)))
|
||||
library-files)))
|
||||
|
||||
(when debug?
|
||||
(display "[DEBUG] scheme-command: ")
|
||||
(write scheme-command)
|
||||
(newline))
|
||||
|
||||
(when (and (equal? scheme-type 'interpreter) input-file)
|
||||
(when (and output-file (file-exists? output-file))
|
||||
|
|
@ -298,4 +274,3 @@
|
|||
(when (not (= exit-code 0))
|
||||
(exit exit-code))))
|
||||
scheme-command))
|
||||
|
||||
|
|
|
|||
|
|
@ -16,8 +16,6 @@
|
|||
(scheme process-context)
|
||||
(foreign c))))
|
||||
(export system
|
||||
echo
|
||||
cat
|
||||
r6rs-schemes
|
||||
r7rs-schemes
|
||||
all-schemes
|
||||
|
|
@ -53,9 +51,6 @@
|
|||
(define-c-procedure c-system c-stdlib 'system 'int '(pointer))
|
||||
(define (system cmd)
|
||||
(c-system (string->c-utf8 cmd)))))
|
||||
|
||||
(define (echo text) (display text) (newline))
|
||||
(define (cat path) (for-each (lambda (line) (echo line)) (file->list path)))
|
||||
(define r6rs-schemes '(capyscheme
|
||||
chezscheme
|
||||
guile
|
||||
|
|
|
|||
Loading…
Reference in New Issue