From 49503db2c658efa1a11dbbb7daebd8f4d5d738cb Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 7 Dec 2025 08:17:19 +0200 Subject: [PATCH] Clean up code --- Makefile | 33 +++------------- compile-scheme.scm | 93 +++++++++++++++++----------------------------- libs/util.sld | 5 --- 3 files changed, 39 insertions(+), 92 deletions(-) diff --git a/Makefile b/Makefile index f275536..a5ed479 100644 --- a/Makefile +++ b/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 diff --git a/compile-scheme.scm b/compile-scheme.scm index 6ae09d3..175d410 100644 --- a/compile-scheme.scm +++ b/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 - (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)) - diff --git a/libs/util.sld b/libs/util.sld index 2ce6477..37b12a1 100644 --- a/libs/util.sld +++ b/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