From 2832477ef80a295b4b3289fc7a3edb5a0b7e8cef Mon Sep 17 00:00:00 2001 From: Mathis Laroche Date: Tue, 14 Jan 2025 17:26:07 -0500 Subject: [PATCH 1/6] Fixed ##include-string and resource-readers for http and ipfs --- src/lib/resource/http.scm | 15 ++++++++++++++- src/lib/resource/ipfs.scm | 2 +- src/lib/resource/macros.scm | 2 ++ src/rsc.scm | 11 ++++++++++- 4 files changed, 27 insertions(+), 3 deletions(-) diff --git a/src/lib/resource/http.scm b/src/lib/resource/http.scm index 881795155..ff14f6ef9 100644 --- a/src/lib/resource/http.scm +++ b/src/lib/resource/http.scm @@ -3,4 +3,17 @@ (##define-resource-reader http (lambda (resource-path) - (shell-cmd (string-append "curl --silent http://" resource-path)))) + (let ((resource-path-real + (if (string-prefix? "http:/" resource-path) + (string-append "http://" (substring resource-path (string-length "http:/") (string-length resource-path))) + (string-append "http://" resource-path)))) + (open-input-string (pipe-through (string-append "curl --silent " resource-path-real) ""))))) + +(##define-resource-reader + https + (lambda (resource-path) + (let ((resource-path-real + (if (string-prefix? "https:/" resource-path) + (string-append "https://" (substring resource-path (string-length "https:/") (string-length resource-path))) + (string-append "https://" resource-path)))) + (open-input-string (pipe-through (string-append "curl --silent " resource-path-real) ""))))) diff --git a/src/lib/resource/ipfs.scm b/src/lib/resource/ipfs.scm index 154f04063..111603d8e 100644 --- a/src/lib/resource/ipfs.scm +++ b/src/lib/resource/ipfs.scm @@ -3,4 +3,4 @@ (##define-resource-reader ipfs (lambda (resource-path) - (shell-cmd (string-append "ipfs cat " resource-path)))) + (open-input-string (pipe-through (string-append "ipfs cat " resource-path) "")))) diff --git a/src/lib/resource/macros.scm b/src/lib/resource/macros.scm index e766c2174..8073e502e 100644 --- a/src/lib/resource/macros.scm +++ b/src/lib/resource/macros.scm @@ -1,3 +1,5 @@ +(##include-once (ribbit "define-macro")) + (define-macro (##define-resource-reader name reader) (add-resource-str-reader! diff --git a/src/rsc.scm b/src/rsc.scm index 404bec484..4ccff5677 100755 --- a/src/rsc.scm +++ b/src/rsc.scm @@ -1828,7 +1828,7 @@ mtx) #f)))) - ((eqv? first '##include-str) + ((eqv? first '##include-string) (expand-expr (read-str-resource (parse-resource (cadr expr))) mtx)) (else @@ -2140,6 +2140,15 @@ ((cadr reader) resource-path) (error "No resource reader found for resource-type:" (resource-type resource))))) +(define (read-char-list input-port) + (let loop ((c (read-char input-port))) + (cond + ((eof-object? c) '()) + (else (cons c (loop (read-char input-port))))))) + +(define (read-str-resource resource) + (list->string (read-char-list (get-resource-port resource)))) + (define (expand-resource resource mtx) (let ((old-current-resource current-resource)) (set! current-resource resource) From 189f65cd6ba67494c45c99822444f0af14d252b8 Mon Sep 17 00:00:00 2001 From: Mathis Laroche Date: Wed, 15 Jan 2025 11:57:20 -0500 Subject: [PATCH 2/6] FIXED - in nodejs, shell-cmd now returns the error instead of throwing --- src/lib/r4rs/sys.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/r4rs/sys.scm b/src/lib/r4rs/sys.scm index de9c5e816..769883614 100644 --- a/src/lib/r4rs/sys.scm +++ b/src/lib/r4rs/sys.scm @@ -21,7 +21,7 @@ (define-primitive (##shell-cmd cmd) (use js/node js/node/fs scm2list list2scm scm2str str2scm) - "prim1(cmd => str2scm(String(require('child_process').execSync(`sh -c '${scm2str(cmd)}'`)))),") + "prim1(cmd => str2scm((()=>{const r=(require('child_process').spawnSync(`${scm2str(cmd)}`,{shell:true}));return r.error ? `Error: ${String(r.stderr)}` : String(r.stdout);})())),") (define (list-dir dir-name) (##list-dir dir-name)) (define (current-directory) (##current-directory))) From 89d9b2186ecdc012a67d695936658e77b937d3ee Mon Sep 17 00:00:00 2001 From: Mathis Laroche Date: Wed, 15 Jan 2025 11:59:44 -0500 Subject: [PATCH 3/6] ADDED - rsc cli option --prefix-code FILE.scm --- src/bin/rsc | 3 +++ src/rsc.scm | 22 +++++++++++++++------- 2 files changed, 18 insertions(+), 7 deletions(-) create mode 100755 src/bin/rsc diff --git a/src/bin/rsc b/src/bin/rsc new file mode 100755 index 000000000..786912927 --- /dev/null +++ b/src/bin/rsc @@ -0,0 +1,3 @@ +#!/bin/sh + +$(dirname $0)/../rsc.exe $@ diff --git a/src/rsc.scm b/src/rsc.scm index 4ccff5677..38527344e 100755 --- a/src/rsc.scm +++ b/src/rsc.scm @@ -333,9 +333,10 @@ (let ((path (string-replace (string-replace path "//" "/") "/./" "/"))) (if (string-prefix? "./" path) (loop (substring path 2 (string-length path))) - (if (string-prefix? "../" path) - (loop (substring path 3 (string-length path))) - path))))) + path)))) + ;; (if (string-prefix? "../" path) + ;; (loop (substring path 3 (string-length path))) + ;; path) (cond-expand @@ -4049,8 +4050,9 @@ (define (read-library lib-path) `((##include-once (ribbit ,lib-path)))) -(define (read-program lib-path src-path) +(define (read-program lib-path src-path prefix-code) (append (apply append (map read-library lib-path)) + (if (not prefix-code) '() (read-from-file prefix-code)) (if (equal? src-path "-") (read-all) (read-from-file src-path)))) @@ -4738,6 +4740,7 @@ (define target "rvm") (define (fancy-compiler src-path + prefix-code output-path exe-output-path rvm-path @@ -4768,8 +4771,8 @@ (let* ((vm-source (if (equal? _target "rvm") #f - (string-from-file - (path-expand rvm-path + (string-from-file rvm-path + #;(path-expand rvm-path (root-dir))))) (host-file (if (equal? _target "rvm") @@ -4807,7 +4810,7 @@ (program-read (report-status "Reading program source code" - (read-program lib-path src-path))) + (read-program lib-path src-path prefix-code))) (program-compiled (report-status @@ -4911,6 +4914,7 @@ The output is written to output.c, with an executable compiled to run-output.exe (let ((verbosity 0) (debug-info '()) (target "rvm") + (prefix-code #f) (input-path #f) (output-path #f) (exe-output-path #f) @@ -4934,6 +4938,9 @@ The output is written to output.c, with an executable compiled to run-output.exe ((and (pair? rest) (member arg '("-i" "--input"))) (set! input-path (car rest)) (loop (cdr rest))) + ((and (pair? rest) (member arg '("--prefix-code"))) + (set! prefix-code (car rest)) + (loop (cdr rest))) ((and (pair? rest) (member arg '("-o" "--output"))) (set! output-path (car rest)) (loop (cdr rest))) @@ -5030,6 +5037,7 @@ The output is written to output.c, with an executable compiled to run-output.exe (fancy-compiler src-path + prefix-code (or output-path (if (or (equal? src-path "-") (equal? target "rvm")) "-" From 1d4192d6ffd9200d11adca6e9c75982bed53dab1 Mon Sep 17 00:00:00 2001 From: Mathis Laroche Date: Wed, 15 Jan 2025 12:21:11 -0500 Subject: [PATCH 4/6] FIXED - nodejs shell-cmd primitive --- src/lib/r4rs/sys.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/r4rs/sys.scm b/src/lib/r4rs/sys.scm index 769883614..3e4deec23 100644 --- a/src/lib/r4rs/sys.scm +++ b/src/lib/r4rs/sys.scm @@ -21,7 +21,7 @@ (define-primitive (##shell-cmd cmd) (use js/node js/node/fs scm2list list2scm scm2str str2scm) - "prim1(cmd => str2scm((()=>{const r=(require('child_process').spawnSync(`${scm2str(cmd)}`,{shell:true}));return r.error ? `Error: ${String(r.stderr)}` : String(r.stdout);})())),") + "prim1(cmd => str2scm((()=>{const r=(require('child_process').spawnSync(`${scm2str(cmd)}`,{shell:true}));return r.status!==0 ? `Error: ${String(r.stdout)}` : String(r.stdout);})())),") (define (list-dir dir-name) (##list-dir dir-name)) (define (current-directory) (##current-directory))) From 856c51f10da2f499ac5ee35042810d66be8012ea Mon Sep 17 00:00:00 2001 From: Mathis Laroche Date: Wed, 15 Jan 2025 12:33:43 -0500 Subject: [PATCH 5/6] PATCHED - Removed a comment --- src/rsc.scm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/rsc.scm b/src/rsc.scm index 38527344e..34c9da361 100755 --- a/src/rsc.scm +++ b/src/rsc.scm @@ -4771,9 +4771,7 @@ (let* ((vm-source (if (equal? _target "rvm") #f - (string-from-file rvm-path - #;(path-expand rvm-path - (root-dir))))) + (string-from-file rvm-path))) (host-file (if (equal? _target "rvm") #f From b186084063712de8ba232ab2b201f8e2b5f6a4b6 Mon Sep 17 00:00:00 2001 From: Mathis Laroche Date: Wed, 15 Jan 2025 12:39:27 -0500 Subject: [PATCH 6/6] MOD - changed the display when no source files to an error --- src/rsc.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/rsc.scm b/src/rsc.scm index 34c9da361..bb86dc159 100755 --- a/src/rsc.scm +++ b/src/rsc.scm @@ -5030,7 +5030,7 @@ The output is written to output.c, with an executable compiled to run-output.exe (if (not src-path) (begin - (display "*** a Scheme source file must be specified\n") + (error "*** a Scheme source file must be specified\n") (exit-program-abnormally)) (fancy-compiler