Clean up code

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

compile-scheme.scm

@@ -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
+(define library-files
-  (lambda (directory)
+  (library-dependencies scheme
-    (let ((result (list)))
+                        (append prepend-directories append-directories)
-      (for-each
+                        (if input-file
-        (lambda (file)
+                          input-file
-          (let* ((path (string-append directory "/" file))
+                          single-library-input-file)
-                 (info (file-info path #f)))
+                        (list)
-            (when (and (not r6rs?)
+                        (list)))
-                       (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 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
+    (for-each
-           (lambda (file)
+      (lambda (file)
-             (let* ((library-command (scheme-library-command file)))
+        (let* ((library-command (scheme-library-command file)))
-               (for-each
+          (when debug?
-                 (lambda (command)
+            (display "[DEBUG] library-command: ")
-                   (let ((exit-code (system command)))
+            (write library-command)
-                     (when (not (= exit-code 0))
+            (newline))
-                       (exit exit-code))))
+          (for-each
-                 library-command)))
+            (lambda (command)
-           library-files)))
+              (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))
-

libs/util.sld

@@ -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