"Dr. Arne Babenhauserheide" <arne_...@web.de> writes: > I’m attaching the new squashed patch again here and will add the patches > for the review changes to a second email.
Attached are the promised patches of the additional review changes. Thank you for your review!
From 3d9b452137911e1948586657edb1ea614d8a70c0 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Tue, 15 Aug 2023 00:43:53 +0200 Subject: [PATCH 12/21] SRFI-119 (Wisp): Fix: capitalize Wisp * doc/ref/srfi-modules.texi (srfi-119): capitalize Wisp --- doc/ref/srfi-modules.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 5b82f8070..0ffc01252 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -5686,7 +5686,7 @@ define : factorial n @result{} (define (factorial n) * n : factorial @{n - 1@} @result{} (* n (factorial @{n - 1@})))) @end example -To execute a file with wisp code, select the language and filename +To execute a file with Wisp code, select the language and filename extension @code{.w} vie @code{guile --language=wisp -x .w}. In files using Wisp, @xref{SRFI-105} (Curly Infix) is always activated. -- 2.41.0
From d8585c6380cbdba2ad0f6c56aaf6637826cd5b93 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Tue, 15 Aug 2023 00:46:53 +0200 Subject: [PATCH 13/21] SRFI-119 (Wisp): Fix: capitalize Scheme * modules/language/wisp.scm (comments): capitalize Scheme --- module/language/wisp.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index b4e885eec..f3127c9d3 100644 --- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -21,7 +21,7 @@ ;;; Commentary: ;; Scheme-only implementation of a wisp-preprocessor which output a -;; scheme code tree to feed to a scheme interpreter instead of a +;; Scheme code tree to feed to a Scheme interpreter instead of a ;; preprocessed file. ;; Limitations: -- 2.41.0
From 44344fa738cb51b034bb03791a6e1ee828390a42 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Tue, 15 Aug 2023 00:56:07 +0200 Subject: [PATCH 14/21] SRFI-119 (Wisp): Fix: capitalize Wisp * modules/language/wisp/spec.scm (define-language): capitalize Wisp --- module/language/wisp/spec.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/module/language/wisp/spec.scm b/module/language/wisp/spec.scm index 1efd3e8b2..5f8feca9a 100644 --- a/module/language/wisp/spec.scm +++ b/module/language/wisp/spec.scm @@ -57,7 +57,7 @@ #:compilers `((tree-il . ,compile-tree-il)) #:decompilers `((tree-il . ,decompile-tree-il)) #:evaluator (lambda (x module) (primitive-eval x)) - #:printer write ; TODO: backtransform to wisp? Use source-properties? + #:printer write ; TODO: backtransform to Wisp? Use source-properties? #:make-default-environment (lambda () ;; Ideally we'd duplicate the whole module hierarchy so that `set!', -- 2.41.0
From 16967e979262f7f3d86e194295a1a3f5a7f68cd0 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Fri, 18 Aug 2023 19:06:23 +0200 Subject: [PATCH 15/21] SRFI-119 (Wisp): cleanup char-list cond * module/language/wisp.scm (match-charlist-to-repr): use helper and re-indent --- module/language/wisp.scm | 38 +++++++++++++++----------------------- 1 file changed, 15 insertions(+), 23 deletions(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index f3127c9d3..3ac128df2 100644 --- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -97,30 +97,22 @@ ;; TODO: wrap the reader to return the repr of the syntax reader ;; additions -(define (match-charlist-to-repr charlist) - (let - ((chlist (reverse charlist))) +(define (equal-rest? chars . args) + (equal? chars args)) + +(define (match-charlist-to-repr char-list) + (let ((chars (reverse char-list))) (cond - ((equal? chlist (list #\.)) - repr-dot) - ((equal? chlist (list #\')) - repr-quote) - ((equal? chlist (list #\,)) - repr-unquote) - ((equal? chlist (list #\`)) - repr-quasiquote) - ((equal? chlist (list #\, #\@)) - repr-unquote-splicing) - ((equal? chlist (list #\# #\')) - repr-syntax) - ((equal? chlist (list #\# #\,)) - repr-unsyntax) - ((equal? chlist (list #\# #\`)) - repr-quasisyntax) - ((equal? chlist (list #\# #\, #\@)) - repr-unsyntax-splicing) - (else - #f)))) + ((equal-rest? chars #\.) repr-dot) + ((equal-rest? chars #\') repr-quote) + ((equal-rest? chars #\,) repr-unquote) + ((equal-rest? chars #\`) repr-quasiquote) + ((equal-rest? chars #\, #\@) repr-unquote-splicing) + ((equal-rest? chars #\# #\') repr-syntax) + ((equal-rest? chars #\# #\,) repr-unsyntax) + ((equal-rest? chars #\# #\`) repr-quasisyntax) + ((equal-rest? chars #\# #\, #\@) repr-unsyntax-splicing) + (else #f)))) (define (wisp-read port) "wrap read to catch list prefixes." -- 2.41.0
From a74e63f65e6f02c9aeff76bf1d6a93043fa95c45 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Fri, 18 Aug 2023 19:10:07 +0200 Subject: [PATCH 16/21] SRFI-119 (Wisp): improve docstring * module/language/wisp.scm (wisp-read): improve docstring --- module/language/wisp.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index 3ac128df2..96429218d 100644 --- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -115,7 +115,7 @@ (else #f)))) (define (wisp-read port) - "wrap read to catch list prefixes." + "Wrap read to catch list prefixes: read one or several chars from PORT and return read symbols or replacement-symbols as representation for special forms." (let ((prefix-maxlen 4)) (let longpeek ((peeked '()) -- 2.41.0
From 361c00fc77a3cd8621be47a37fca18265ae59310 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Fri, 18 Aug 2023 19:14:07 +0200 Subject: [PATCH 17/21] SRFI-119 (Wisp): improve let and let* formatting * module/language/wisp.scm (wisp-read, wisp-scheme-read-chunk-lines): clean up let and let* arguments --- module/language/wisp.scm | 133 +++++++++++++++++++-------------------- 1 file changed, 64 insertions(+), 69 deletions(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index 96429218d..3b14eba54 100644 --- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -117,15 +117,15 @@ (define (wisp-read port) "Wrap read to catch list prefixes: read one or several chars from PORT and return read symbols or replacement-symbols as representation for special forms." (let ((prefix-maxlen 4)) - (let longpeek - ((peeked '()) - (repr-symbol #f)) + (let longpeek ((peeked '()) (repr-symbol #f)) (cond - ((or (< prefix-maxlen (length peeked)) (eof-object? (peek-char port)) (equal? #\space (peek-char port)) (equal? #\newline (peek-char port))) + ((or (< prefix-maxlen (length peeked)) + (eof-object? (peek-char port)) + (equal? #\space (peek-char port)) + (equal? #\newline (peek-char port))) (if repr-symbol ; found a special symbol, return it. repr-symbol - (let unpeek - ((remaining peeked)) + (let unpeek ((remaining peeked)) (cond ((equal? '() remaining) (read port)); let read to the work @@ -133,9 +133,8 @@ (unread-char (car remaining) port) (unpeek (cdr remaining))))))) (else - (let* - ((next-char (read-char port)) - (peeked (cons next-char peeked))) + (let* ((next-char (read-char port)) + (peeked (cons next-char peeked))) (longpeek peeked (match-charlist-to-repr peeked)))))))) @@ -172,9 +171,8 @@ (define (indent-level-reduction indentation-levels level select-fun) "Reduce the INDENTATION-LEVELS to the given LEVEL and return the value selected by SELECT-FUN" - (let loop - ((newlevels indentation-levels) - (diff 0)) + (let loop ((newlevels indentation-levels) + (diff 0)) (cond ((= level (car newlevels)) (select-fun (list diff indentation-levels))) @@ -230,7 +228,14 @@ (set-source-property! line 'filename (port-filename port)) (set-source-property! line 'line (port-line port)) (append indent-and-symbols (list line)))) - ((and in-indent? (zero? currentindent) (not in-comment?) (not (null? indent-and-symbols)) (not in-underscoreindent?) (not (or (equal? #\space next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) next-char)))) + ((and in-indent? + (zero? currentindent) + (not in-comment?) + (not (null? indent-and-symbols)) + (not in-underscoreindent?) + (not (or (equal? #\space next-char) + (equal? #\newline next-char) + (equal? (string-ref ";" 0) next-char)))) (append indent-and-symbols)); top-level form ends chunk ((chunk-ends-with-period currentsymbols next-char) ;; the line ends with a period. This is forbidden in @@ -259,9 +264,10 @@ emptylines)) ;; any char but whitespace *after* underscoreindent is ;; an error. This is stricter than the current wisp - ;; syntax definition. TODO: Fix the definition. Better - ;; start too strict. FIXME: breaks on lines with only - ;; underscores which should be empty lines. + ;; syntax definition. + ;; TODO: Fix the definition. Better start too strict. + ;; FIXME: breaks on lines with only underscores which should be + ;; empty lines. ((and in-underscoreindent? (and (not (equal? #\space next-char)) (not (equal? #\newline next-char)))) (raise-exception (make-exception-from-throw 'wisp-syntax-error (list "initial underscores without following whitespace at beginning of the line after" (last indent-and-symbols))))) ((equal? #\newline next-char) @@ -351,9 +357,8 @@ (define (line-code-replace-inline-colons line) "Replace inline colons by opening parens which close at the end of the line" ;; format #t "replace inline colons for line ~A\n" line - (let loop - ((processed '()) - (unprocessed line)) + (let loop ((processed '()) + (unprocessed line)) (cond ((null? unprocessed) ;; format #t "inline-colons processed line: ~A\n" processed @@ -417,9 +422,8 @@ (define (wisp-propagate-source-properties code) "Propagate the source properties from the sourrounding list into every part of the code." - (let loop - ((processed '()) - (unprocessed code)) + (let loop ((processed '()) + (unprocessed code)) (cond ((and (null? processed) (not (pair? unprocessed)) (not (list? unprocessed))) unprocessed) @@ -460,22 +464,20 @@ (list (format #f "The first symbol in a chunk must start at zero indentation. Indentation and line: ~A" (car lines))))))) - (let loop - ((processed '()) - (unprocessed lines) - (indentation-levels '(0))) - (let* - ((current-line - (if (<= 1 (length unprocessed)) - (car unprocessed) - (make-line 0))); empty code - (next-line - (if (<= 2 (length unprocessed)) - (car (cdr unprocessed)) - (make-line 0))); empty code - (current-indentation - (car indentation-levels)) - (current-line-indentation (line-real-indent current-line))) + (let loop ((processed '()) + (unprocessed lines) + (indentation-levels '(0))) + (let* ((current-line + (if (<= 1 (length unprocessed)) + (car unprocessed) + (make-line 0))); empty code + (next-line + (if (<= 2 (length unprocessed)) + (car (cdr unprocessed)) + (make-line 0))); empty code + (current-indentation + (car indentation-levels)) + (current-line-indentation (line-real-indent current-line))) ;; format #t "processed: ~A\ncurrent-line: ~A\nnext-line: ~A\nunprocessed: ~A\nindentation-levels: ~A\ncurrent-indentation: ~A\n\n" ;; . processed current-line next-line unprocessed indentation-levels current-indentation (cond @@ -528,9 +530,8 @@ current-line-indentation (cdr indentation-levels))))))) ((= current-indentation current-line-indentation) - (let - ((line (line-finalize current-line)) - (next-line-indentation (line-real-indent next-line))) + (let ((line (line-finalize current-line)) + (next-line-indentation (line-real-indent next-line))) (cond ((>= current-line-indentation next-line-indentation) ;; simple recursiive step to the next line @@ -571,9 +572,8 @@ (define (wisp-scheme-replace-inline-colons lines) "Replace inline colons by opening parens which close at the end of the line" - (let loop - ((processed '()) - (unprocessed lines)) + (let loop ((processed '()) + (unprocessed lines)) (if (null? unprocessed) processed (loop @@ -583,9 +583,8 @@ (define (wisp-scheme-strip-indentation-markers lines) "Strip the indentation markers from the beginning of the lines" - (let loop - ((processed '()) - (unprocessed lines)) + (let loop ((processed '()) + (unprocessed lines)) (if (null? unprocessed) processed (loop @@ -684,21 +683,20 @@ Match is awesome!" (wisp-add-source-properties-from/when-required code form)) (wisp-add-source-properties-from/when-required code - (let - ((improper - (match code - ((a ... b 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd c) - (set! is-proper? #f) - (wisp-add-source-properties-from/when-required - code - (append (map wisp-make-improper (map add-prop/req a)) - (cons (wisp-make-improper (add-prop/req b)) - (wisp-make-improper (add-prop/req c)))))) - ((a ...) - (add-prop/req - (map wisp-make-improper (map add-prop/req a)))) - (a - a)))) + (let ((improper + (match code + ((a ... b 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd c) + (set! is-proper? #f) + (wisp-add-source-properties-from/when-required + code + (append (map wisp-make-improper (map add-prop/req a)) + (cons (wisp-make-improper (add-prop/req b)) + (wisp-make-improper (add-prop/req c)))))) + ((a ...) + (add-prop/req + (map wisp-make-improper (map add-prop/req a)))) + (a + a)))) (define (syntax-error li msg) (raise-exception (make-exception-from-throw @@ -706,8 +704,7 @@ Match is awesome!" (list (format #f "incorrect dot-syntax #{.}# in code: ~A: ~A" msg li))))) (if is-proper? improper - (let check - ((tocheck improper)) + (let check ((tocheck improper)) (match tocheck ;; lists with only one member (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) @@ -725,9 +722,8 @@ Match is awesome!" (syntax-error tocheck "dot as last element in already improper pair")) ;; more complex pairs ((? pair? a) - (let - ((head (drop-right a 1)) - (tail (last-pair a))) + (let ((head (drop-right a 1)) + (tail (last-pair a))) (cond ((equal? repr-dot (car tail)) (syntax-error tocheck "equal? repr-dot : car tail")) @@ -754,8 +750,7 @@ Match is awesome!" (define (wisp-scheme-read-all port) "Read all chunks from the given port" - (let loop - ((tokens '())) + (let loop ((tokens '())) (cond ((eof-object? (peek-char port)) tokens) -- 2.41.0
From 0ca2a934c96d657c996d8b2f0241cc7e38ae2a0e Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Fri, 18 Aug 2023 19:15:20 +0200 Subject: [PATCH 18/21] SRFI-119 (Wisp): Fix comment syntax and trailing whitespace * module/language/wisp/spec.scm (define-language): comment with ;;, strip trailing lines --- module/language/wisp/spec.scm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/module/language/wisp/spec.scm b/module/language/wisp/spec.scm index 5f8feca9a..f7fd794e0 100644 --- a/module/language/wisp/spec.scm +++ b/module/language/wisp/spec.scm @@ -52,7 +52,7 @@ (define-language wisp #:title "Wisp Scheme Syntax. See SRFI-119 for details" - ; . #:reader read-one-wisp-sexp + ;; . #:reader read-one-wisp-sexp #:reader read-one-wisp-sexp ; : lambda (port env) : let ((x (read-one-wisp-sexp port env))) (display x)(newline) x ; #:compilers `((tree-il . ,compile-tree-il)) #:decompilers `((tree-il . ,decompile-tree-il)) @@ -68,6 +68,3 @@ ;; limited to the current compilation unit. (module-define! m 'current-reader (make-fluid)) m))) - - - -- 2.41.0
From 7de03c8ce421e809afb95823037d655aa9a47fd2 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Fri, 18 Aug 2023 19:17:25 +0200 Subject: [PATCH 19/21] SRFI-119 (Wisp): reindent test * test-suite/tests/srfi-119.test (with-read-options, wisp->list): M-x indent-region --- test-suite/tests/srfi-119.test | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test index f4a19a0a7..6fe87f2b2 100644 --- a/test-suite/tests/srfi-119.test +++ b/test-suite/tests/srfi-119.test @@ -27,14 +27,14 @@ (define (with-read-options opts thunk) (let ((saved-options (read-options))) (dynamic-wind - (lambda () - (read-options opts)) - thunk - (lambda () - (read-options saved-options))))) + (lambda () + (read-options opts)) + thunk + (lambda () + (read-options saved-options))))) (define (wisp->list str) - (wisp-scheme-read-string str)) + (wisp-scheme-read-string str)) (with-test-prefix "wisp-read-simple" (pass-if (equal? (wisp->list "<= n 5") '((<= n 5)))) -- 2.41.0
From 8cd856e060840277b1a8b30892d6ef4f55fe5c7a Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Fri, 18 Aug 2023 19:19:40 +0200 Subject: [PATCH 20/21] SRFI-119 (Wisp): use pass-if-equal instead of pass-if (equal? ...) * test-suite/tests/srfi-119.test (wisp-read-simple, wisp-read-complex): use pass-if-equal and invert conditions to improve error messages --- test-suite/tests/srfi-119.test | 54 ++++++++++++++++++---------------- 1 file changed, 29 insertions(+), 25 deletions(-) diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test index 6fe87f2b2..64ccc2ff6 100644 --- a/test-suite/tests/srfi-119.test +++ b/test-suite/tests/srfi-119.test @@ -37,11 +37,21 @@ (wisp-scheme-read-string str)) (with-test-prefix "wisp-read-simple" - (pass-if (equal? (wisp->list "<= n 5") '((<= n 5)))) - (pass-if (equal? (wisp->list ". 5") '(5))) - (pass-if (equal? (wisp->list "+ 1 : * 2 3") '((+ 1 (* 2 3)))))) + (pass-if-equal '((<= n 5)) + (wisp->list "<= n 5")) + (pass-if-equal '(5) + (wisp->list ". 5")) + (pass-if-equal '((+ 1 (* 2 3))) + (wisp->list "+ 1 : * 2 3"))) (with-test-prefix "wisp-read-complex" - (pass-if (equal? (wisp->list " + (pass-if-equal '( + (a b c d e + f g h + i j k) + + (concat "I want " + (getwish from me) + " - " username)) (wisp->list " a b c d e . f g h . i j k @@ -49,16 +59,20 @@ a b c d e concat \"I want \" getwish from me . \" - \" username -") '( -(a b c d e - f g h - i j k) +")) + + (pass-if-equal + '( + (define (a b c) + (d e + (f) + (g h) + i)) -(concat "I want " - (getwish from me) - " - " username)))) + (define (_) + (display "hello\n")) - (pass-if (equal? (wisp->list " + (_)) (wisp->list " define : a b c _ d e ___ f @@ -68,21 +82,11 @@ __ . i define : _ _ display \"hello\n\" -\\_") '( -(define (a b c) - (d e - (f) - (g h) - i)) - -(define (_) - (display "hello\n")) - -(_)))) +\\_")) ;; nesting with pairs - (pass-if (equal? (wisp->list "1 . 2\n3 4\n 5 . 6") - '((1 . 2)(3 4 (5 . 6)))))) + (pass-if-equal '((1 . 2)(3 4 (5 . 6))) + (wisp->list "1 . 2\n3 4\n 5 . 6"))) (with-test-prefix "wisp-source-properties" (pass-if (not (find null? (map source-properties (wisp->list "1 . 2\n3 4\n 5 . 6"))))) -- 2.41.0
From e120fc39aca45d55ede90b4200b7b9e39bc83e1e Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <arne_...@web.de> Date: Fri, 18 Aug 2023 19:25:59 +0200 Subject: [PATCH 21/21] SRFI-119 (Wisp): add tests for equality of source-properties and fix them * test-suite/tests/srfi-119.test (scheme->list): new procedure * test-suite/tests/srfi-119.test (wisp-source-properties): use pass-if (every pair? ...) for the existance test. Use scheme->list to compare source-properties from regular Scheme read and wisp read. * module/language/wisp.scm (line-code): replace custom logic with wisp-add-source-properties-from/when-required * module/language/wisp.scm (wisp-scheme-read-chunk-lines): set the line-number from the start of the chunk as source-property instead of the line number from the end of the chunk. --- module/language/wisp.scm | 57 ++++++++++++++++++---------------- test-suite/tests/srfi-119.test | 19 ++++++++++-- 2 files changed, 48 insertions(+), 28 deletions(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index 3b14eba54..dae9642ae 100644 --- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -45,6 +45,24 @@ (read-enable 'curly-infix)) +;; Helpers to preserver source properties + +(define (wisp-add-source-properties-from source target) + "Copy the source properties from source into the target and return the target." + (catch #t + (lambda () + (set-source-properties! target (source-properties source))) + (lambda (key . arguments) + #f)) + target) + +(define (wisp-add-source-properties-from/when-required source target) + "Copy the source properties if target has none." + (if (null? (source-properties target)) + (wisp-add-source-properties-from source target) + target)) + + ;; Helper functions for the indent-and-symbols data structure: '((indent token token ...) ...) (define make-line list) @@ -63,7 +81,7 @@ (let ((code (cdr line))) ;; propagate source properties (when (not (null? code)) - (set-source-properties! code (source-properties line))) + (wisp-add-source-properties-from/when-required line code)) code)) ;; literal values I need @@ -204,14 +222,16 @@ (define (wisp-scheme-read-chunk-lines port) - (let loop - ((indent-and-symbols (list)); '((5 "(foobar)" "\"yobble\"")(3 "#t")) - (in-indent? #t) - (in-underscoreindent? (equal? #\_ (peek-char port))) - (in-comment? #f) - (currentindent 0) - (currentsymbols '()) - (emptylines 0)) + ;; the line number for this chunk is the line number when starting to read it + ;; a top-level form stops processing, so we only need to retrieve this here. + (define line-number (port-line port)) + (let loop ((indent-and-symbols (list)); '((5 "(foobar)" "\"yobble\"")(3 "#t")) + (in-indent? #t) + (in-underscoreindent? (equal? #\_ (peek-char port))) + (in-comment? #f) + (currentindent 0) + (currentsymbols '()) + (emptylines 0)) (cond ((>= emptylines 2) ;; the chunk end has to be checked @@ -226,7 +246,7 @@ ((eof-object? next-char) (let ((line (apply make-line currentindent currentsymbols))) (set-source-property! line 'filename (port-filename port)) - (set-source-property! line 'line (port-line port)) + (set-source-property! line 'line line-number) (append indent-and-symbols (list line)))) ((and in-indent? (zero? currentindent) @@ -296,7 +316,7 @@ (when (not (= 0 (length (line-code parsedline)))) ;; set the source properties to parsedline so we can try to add them later. (set-source-property! parsedline 'filename (port-filename port)) - (set-source-property! parsedline 'line (port-line port))) + (set-source-property! parsedline 'line line-number)) ;; TODO: If the line is empty. Either do it here and do not add it, just ;; increment the empty line counter, or strip it later. Replace indent ;; -1 by indent 0 afterwards. @@ -405,21 +425,6 @@ #f))) l)) -(define (wisp-add-source-properties-from source target) - "Copy the source properties from source into the target and return the target." - (catch #t - (lambda () - (set-source-properties! target (source-properties source))) - (lambda (key . arguments) - #f)) - target) - -(define (wisp-add-source-properties-from/when-required source target) - "Copy the source properties if target has none." - (if (null? (source-properties target)) - (wisp-add-source-properties-from source target) - target)) - (define (wisp-propagate-source-properties code) "Propagate the source properties from the sourrounding list into every part of the code." (let loop ((processed '()) diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test index 64ccc2ff6..60e1e0377 100644 --- a/test-suite/tests/srfi-119.test +++ b/test-suite/tests/srfi-119.test @@ -19,6 +19,7 @@ (define-module (test-srfi-119) #:use-module (test-suite lib) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) ;; cut #:use-module (language wisp)) (define (read-string s) @@ -36,6 +37,14 @@ (define (wisp->list str) (wisp-scheme-read-string str)) +(define (scheme->list str) + (with-input-from-string str + (λ () + (let loop ((result '())) + (if (eof-object? (peek-char)) + (reverse! result) + (loop (cons (read) result))))))) + (with-test-prefix "wisp-read-simple" (pass-if-equal '((<= n 5)) (wisp->list "<= n 5")) @@ -89,5 +98,11 @@ _ display \"hello\n\" (wisp->list "1 . 2\n3 4\n 5 . 6"))) (with-test-prefix "wisp-source-properties" - (pass-if (not (find null? (map source-properties (wisp->list "1 . 2\n3 4\n 5 . 6"))))) - (pass-if (not (find null? (map source-properties (wisp->list "1 2\n3 4\n 5 6")))))) + ;; has properties + (pass-if (every pair? (map source-properties (wisp->list "1 . 2\n3 4\n 5 . 6")))) + (pass-if (every pair? (map source-properties (wisp->list "1 2\n3 4\n 5 6")))) + ;; has the same properties + (pass-if-equal + (map source-properties (scheme->list "(1 . 2)\n(3 4\n (5 . 6))\n(1 4)\n\n(7 8)")) + (map (cut cons '(filename . #f) <>) + (map source-properties (wisp->list "1 . 2\n3 4\n 5 . 6\n1 4\n\n7 8"))))) -- 2.41.0
Best wishes, Arne -- Unpolitisch sein heißt politisch sein, ohne es zu merken. draketo.de
signature.asc
Description: PGP signature