From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "Dr. Arne Babenhauserheide" Newsgroups: gmane.lisp.guile.devel Subject: Re: [PATCH] add SRFI-119 / language/wisp to Guile? (new patch, squashed) Date: Mon, 14 Aug 2023 22:30:18 +0200 Message-ID: <871qg58ikx.fsf@web.de> References: <87h6w2fkz8.fsf@web.de> <877cwxe4ar.fsf@web.de> <2f7d015d-ceb4-ef8f-b4fe-b69e39b723f8@telenet.be> <87357ldqaq.fsf@web.de> <1a70460e-11fb-9f5d-0d5f-1eb507d5af0d@telenet.be> <87ilg4j65e.fsf@web.de> <87edqsj5vt.fsf@web.de> <01212259-37dd-5d67-7bbc-101e01d96d01@telenet.be> <1a6c8dda-0124-124c-f932-937a11386ced@gmail.com> <87fsb5i912.fsf@web.de> <87ttzc7gwa.fsf@gnu.org> <1e0d07bc-dcf8-fe56-7f16-a72e5df0c20d@telenet.be> <875ybr2hk9.fsf@gnu.org> <87v8jrdmk5.fsf@web.de> <87jzzr7cba.fsf@web.de> <87v8hc8i8v.fsf@web.de> <87legrs23a.fsf@gnu.org> <209e68fd-b010-8213-6c9b-a0d1b8f0f72c@telenet.be> <87o7jf2slw.fsf@web.de> <875y5h8j04.fsf@web.de> Mime-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="25657"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.10.5; emacs 29.0.92 Cc: Maxime Devos , Ludovic =?utf-8?Q?Court=C3=A8s?= , guile-devel@gnu.org To: "Dr. Arne Babenhauserheide" Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Mon Aug 14 22:39:55 2023 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qVeLy-0006RM-Lu for guile-devel@m.gmane-mx.org; Mon, 14 Aug 2023 22:39:55 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qVeLb-0006rr-N3; Mon, 14 Aug 2023 16:39:31 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qVeLQ-0006pi-SZ for guile-devel@gnu.org; Mon, 14 Aug 2023 16:39:20 -0400 Original-Received: from mout.web.de ([217.72.192.78]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qVeLL-0004wW-FU; Mon, 14 Aug 2023 16:39:20 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=web.de; s=s29768273; t=1692045551; x=1692650351; i=arne_bab@web.de; bh=Q9QGy4gOluPwW15FuVxYsLRRLC78+eR6nGAD2XYlvpc=; h=X-UI-Sender-Class:References:From:To:Cc:Subject:Date:In-reply-to; b=GmVA4ShZCCbB8263T/LBiMdsiDEk/sYpjK6+VXLloiuiIs63JVWsnny8K9QrRFBNeatQpmo QfcHVvt+W7lfMG3skjRJzdqA+mRneOGKux8NhT9jm+3KjQIDkngjlVPHaK9CUJM8IHZNiaVo6 fF6CSNu7p1mr7VLWYkaEh8Y8hUt4bhUl8Kted9YvRZw7I1Qp4pS+Ep3QIB260Z3z5hGxZb9xC aL4RswddQM1gbT7MlvYnEbLjE7fYMdPZ7kb3azUtNVYvT5CN+yBeQ9vtL8PyfxxA6yuJ0+iUg ppKzwRY9qQchsRthAARZkH/ULBoyXU2U8W5CXCrz+GVUunsz54+A== X-UI-Sender-Class: 814a7b36-bfc1-4dae-8640-3722d8ec6cd6 Original-Received: from fluss ([84.165.27.117]) by smtp.web.de (mrweb106 [213.165.67.124]) with ESMTPSA (Nemesis) id 1MfKtN-1ppQyC1WCx-00gqrx; Mon, 14 Aug 2023 22:39:11 +0200 In-reply-to: <875y5h8j04.fsf@web.de> X-Provags-ID: V03:K1:3Bh9bBC05Sm7KsXBdjzepzwNMaws+A1dcaDuPt6rRpjeDKrs0uG L2gx3CvODj8PSmv0v9LKMu1mhUNKfa24lbDbGKmnb7LV2wDT0BBJaHD8Nnhd3Tfy8YK6VjU JgLwBhrcUwvBPMYuQZSa6XJrOElRIqeoKL0gGvG86LP8ne8V4G/yaTmGS4JmdqZTl/R5/Wz Q4iFQbceZIdnGd+bawqCQ== UI-OutboundReport: notjunk:1;M01:P0:p7Oq04bpLhE=;YKALpHzziHz3PhvAYwpQbFlEI8h DgZtaayCmMdt5Agjfn/ZxQCIw4gwJRiWHHjsD4MQCri7/fXZfRQAmNvSTi8dwhzVbZBz9mJ7Z K1OMmWYLSfs4QT4ryFSdlLus/4kZKGBLJpOrk8utsT7Z6jXGGDgXzuYS+lFzPpZdiYLUPO2fP Kvz5U4k+Q/IFj3PzgBd2DXO210K2lPNuIXDEx2+8Fxtis5CqJd2mebQ9F6OKyv+WFZecrEwAa 48d1ZvmFy9yZODjsc56fABFn4r1HQBJxYvkzdQpWTQX2OU1jC47L4Tutvrsfs64M8nzB4UNfG uAuM5Y69k8KlIiafNPLLIPE9Lm8Brv7uskUcYpNQ9xFzJDDazTVwdr2mUb8K8Wkqwk3UQ0HEA eKE9T5knql/7SSYFw76XhWClsASEF3+noffe+hm5Sv4OVOTcbWIARDvMjsr1thtZ3wGfzb6PC 4505F51zFgTPCxITGxE63aIX4gi10+EESuodWWy1LqQ2H+HbYvcqIk7mG+JCf0gmHZmMv1yJ8 Pqx3njsv08T7f3y7TP+NQZRNAGap+G0nHE0fJr5jstCAcVnCMBp+9xHRRObi28woiDJrhoLhd 1QPjm66uCCIJD39SpwTT7IzuVL36lCDqOxmcTDDHn3vTn6T/zLYRwZfqAailsxTrR7kgW5MGa iQ2yCvMoLZsmBEem5N0U6Q0z1clH6ELM/igyvDvf4G+rJNjjC4UQYsszfj3AKS6xJ4RI38Hgh Xd7aJChrmfkeDiGqVmblWDuimWrL/1lpJ3D2gukEFeP/cZ5rjA9g5DqOq6tFPhI7nYyjNJRd Received-SPF: pass client-ip=217.72.192.78; envelope-from=arne_bab@web.de; helo=mout.web.de X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H5=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.devel:21911 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable "Dr. Arne Babenhauserheide" writes: > Attached is a new squashed patch. I=E2=80=99ll send another email with on= ly the > commits for the individual changes on top of the original squashed patch > to avoid tripping up tools that extract diffs. This is the promised email with just the changes compared to the original squashed patch :-) I tried to create atomic changes, but the indentation change mixed a few together that I did not manage to separate (I did that indentation change too early and didn=E2=80=99t commit in time =E2=80=94 I=E2=80=99m so= rry for that). To minimize the impact I added a last change including just a diff without whitespace changes (-w). It starts with DIFF_WITHOUT_WHITESPACE I hope this simplifies reviewing for you! Best wishes, Arne From=20ec1d873871040a7bf99cc8f0ab940e09fd76977b Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Mon, 12 Jun 2023 01:22:56 +0200 Subject: [PATCH 02/11] SRFI-119: add new files to Makefile.am and bootstrap= .am * am/bootstrap.am (SOURCES): add language/wisp.scm and language/wisp/spec.s= cm * test-suite/Makefile.am (SCM_TESTS) add tests/srfi-119.test =2D-- am/bootstrap.am | 3 +++ test-suite/Makefile.am | 3 ++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/am/bootstrap.am b/am/bootstrap.am index ff0d1799e..80a8dcdde 100644 =2D-- a/am/bootstrap.am +++ b/am/bootstrap.am @@ -393,6 +393,9 @@ SOURCES =3D \ \ system/syntax.scm \ \ + language/wisp.scm \ + language/wisp/spec.scm \ + \ system/xref.scm \ \ sxml/apply-templates.scm \ diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 81e63bce2..247d97746 100644 =2D-- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -162,7 +162,8 @@ SCM_TESTS =3D tests/00-initial-env.test \ tests/srfi-98.test \ tests/srfi-105.test \ tests/srfi-111.test \ =2D tests/srfi-171.test \ + tests/srfi-119.test \ + tests/srfi-171.test \ tests/srfi-4.test \ tests/srfi-9.test \ tests/statprof.test \ =2D-=20 2.41.0 From=20c07a1643ca4df87a552abd32cc00d80741ef8e17 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Thu, 10 Aug 2023 08:32:17 +0200 Subject: [PATCH 03/11] SRFI-119: change license of language/wisp/spec to LGPLv3+ * module/language/wisp/spec.scm: changed license. This was changed from LGPLv3+ to MIT for inclusion in SRFI-119 and was now reverted back to LGPLv3+. Permission granted by Maxime Devos who had done changes in the MIT version. =2D-- module/language/wisp/spec.scm | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/module/language/wisp/spec.scm b/module/language/wisp/spec.scm index 477036c71..821033432 100644 =2D-- a/module/language/wisp/spec.scm +++ b/module/language/wisp/spec.scm @@ -6,25 +6,20 @@ ;;; Copyright (C) 2014--2023 Arne Babenhauserheide. ;;; Copyright (C) 2023 Maxime Devos =20 =2D;;; Permission is hereby granted, free of charge, to any person =2D;;; obtaining a copy of this software and associated documentation =2D;;; files (the "Software"), to deal in the Software without =2D;;; restriction, including without limitation the rights to use, copy, =2D;;; modify, merge, publish, distribute, sublicense, and/or sell copies =2D;;; of the Software, and to permit persons to whom the Software is =2D;;; furnished to do so, subject to the following conditions: =2D;;; =2D;;; The above copyright notice and this permission notice shall be =2D;;; included in all copies or substantial portions of the Software. =2D;;; =2D;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, =2D;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF =2D;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND =2D;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS =2D;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN =2D;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN =2D;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE =2D;;; SOFTWARE. +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1= 301 USA + =20 ; adapted from spec.scm: https://gitorious.org/nacre/guile-sweet/source/ae= 306867e371cb4b56e00bb60a50d9a0b8353109:sweet/spec.scm (define-module (language wisp spec) =2D-=20 2.41.0 From=2076bd2f42d3a568453981ce8f60f6b06bfc23ccf5 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Sat, 12 Aug 2023 22:06:50 +0200 Subject: [PATCH 04/11] Polish srfi-119 documentation * doc/ref/srfi-modules.texi (srfi-119): fix capitalization, improve wording, and use two spaces after period for navigation in Emacs. =2D-- doc/ref/srfi-modules.texi | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index e9e64bea8..5b82f8070 100644 =2D-- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -64,7 +64,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-98:: Accessing environment variables. * SRFI-105:: Curly-infix expressions. * SRFI-111:: Boxes. =2D* SRFI-119:: Wisp: simpler indentation-sensitive sche= me. +* SRFI-119:: Wisp: simpler indentation-sensitive Scheme. * SRFI-171:: Transducers @end menu =20 @@ -5664,13 +5664,14 @@ Set the contents of @var{box} to @var{value}. @end deffn =20 @node SRFI-119 =2D@subsection SRFI-119 Wisp: simpler indentation-sensitive scheme. +@subsection SRFI-119 Wisp: simpler indentation-sensitive Scheme. @cindex SRFI-119 @cindex wisp =20 =2DThe languages shipped in Guile include SRFI-119 (wisp), an encoding of =2DScheme that allows replacing parentheses with equivalent indentation and =2Dinline colons. See +The languages shipped in Guile include SRFI-119, also referred to as +@dfn{Wisp} (for ``Whitespace to Lisp''), an encoding of Scheme that +allows replacing parentheses with equivalent indentation and inline +colons. See @uref{http://srfi.schemers.org/srfi-119/srfi-119.html, the specification of SRFI-119}. Some examples: =20 =2D-=20 2.41.0 From=203cc2679d3e2f11c67d52d9c54e8ec66030697006 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Sat, 12 Aug 2023 22:08:54 +0200 Subject: [PATCH 05/11] SRFI-119 spec: fix leading comments * module/language/wisp/spec.scm (comments): fix capitalization, improve wording, and use two spaces after period for navigation in Emacs. =2D-- module/language/wisp/spec.scm | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/module/language/wisp/spec.scm b/module/language/wisp/spec.scm index 821033432..fde08b429 100644 =2D-- a/module/language/wisp/spec.scm +++ b/module/language/wisp/spec.scm @@ -1,10 +1,8 @@ =2D;; Language interface for Wisp in Guile +;;; Language interface for Wisp in Guile =20 =2D;;; adapted from guile-sweet: https://gitorious.org/nacre/guile-sweet/so= urce/ae306867e371cb4b56e00bb60a50d9a0b8353109:sweet/common.scm =2D =2D;;; Copyright (C) 2005--2014 by David A. Wheeler and Alan Manuel K. Glor= ia =2D;;; Copyright (C) 2014--2023 Arne Babenhauserheide. =2D;;; Copyright (C) 2023 Maxime Devos +;; Copyright (C) 2005--2014 by David A. Wheeler and Alan Manuel K. Gloria +;; Copyright (C) 2014--2023 Arne Babenhauserheide. +;; Copyright (C) 2023 Maxime Devos =20 ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -20,8 +18,8 @@ ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1= 301 USA =20 +;; adapted from spec.scm: https://gitorious.org/nacre/guile-sweet/?p=3Dnac= re:guile-sweet.git;a=3Dblob;f=3Dsweet/spec.scm;hb=3Dae306867e371cb4b56e00bb= 60a50d9a0b8353109 =20 =2D; adapted from spec.scm: https://gitorious.org/nacre/guile-sweet/source/= ae306867e371cb4b56e00bb60a50d9a0b8353109:sweet/spec.scm (define-module (language wisp spec) #:use-module (language wisp) #:use-module (system base compile) =2D-=20 2.41.0 From=208c88bdea77ba33ced9e449165c6ad939f3f8c388 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Sat, 12 Aug 2023 22:10:03 +0200 Subject: [PATCH 06/11] SRFI-119 (wisp): review fixes * module/language/wisp.scm (comments): use ;; for all non-margin comments * module/language/wisp.scm (indentation): auto-indent cleanly * module/language/wisp.scm (indent-level-reduction, indent-level-reduction, wisp-scheme-indentation-to-parens, wisp-make-improper): use raise-excep= tion instead of raw throw * module/language/wisp.scm (wisp-scheme-read-chunk-lines): use conventional variable naming in-indent? instead of inindent, also in-underscoreindent? in-comment? * module/language/wisp.scm (top-level): guard read-enable curly-infix with eval-when * module/language/wisp.scm (make-line): new function, alias of list. Change: used as apply make-line indent code (instead of append) =2D-- module/language/wisp.scm | 1225 +++++++++++++++++++------------------- 1 file changed, 604 insertions(+), 621 deletions(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index 7a12e126a..acc1f0725 100644 =2D-- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -31,643 +31,627 @@ ;;; Code: =20 (define-module (language wisp) =2D #:export (wisp-scheme-read-chunk wisp-scheme-read-all=20 =2D wisp-scheme-read-file-chunk wisp-scheme-read-file =2D wisp-scheme-read-string)) + #:export (wisp-scheme-read-chunk wisp-scheme-read-all + wisp-scheme-read-file-chunk wisp-scheme= -read-file + wisp-scheme-read-string) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11); for let-values + #:use-module (srfi srfi-9); for records + #:use-module (ice-9 rw); for write-string/partial + #:use-module (ice-9 match)) =20 =2D; use curly-infix by default =2D(read-enable 'curly-infix) =2D =2D(use-modules =2D (srfi srfi-1) =2D (srfi srfi-11); for let-values =2D (ice-9 rw); for write-string/partial =2D (ice-9 match)) +;; use curly-infix by default +(eval-when (expand load eval) + (read-enable 'curly-infix)) =20 =20 ;; Helper functions for the indent-and-symbols data structure: '((indent t= oken token ...) ...) +(define make-line list) + (define (line-indent line) =2D (car line)) + (car line)) =20 (define (line-real-indent line) =2D "Get the indentation without the comment-marker for unindented = lines (-1 is treated as 0)." =2D (let (( indent (line-indent line))) =2D (if (=3D -1 indent) =2D 0 =2D indent))) + "Get the indentation without the comment-marker for unindented lines (-1= is treated as 0)." + (let ((indent (line-indent line))) + (if (=3D -1 indent) + 0 + indent))) =20 (define (line-code line) =2D (let ((code (cdr line))) =2D ; propagate source properties =2D (when (not (null? code)) =2D (set-source-properties! code (source-properties line= ))) =2D code)) + "Strip the indentation markers from the beginning of the line and preser= ve source-properties" + (let ((code (cdr line))) + ;; propagate source properties + (when (not (null? code)) + (set-source-properties! code (source-properties line))) + code)) =20 =2D; literal values I need =2D(define readcolon=20 =2D (string->symbol ":")) +;; literal values I need +(define readcolon + (string->symbol ":")) =20 (define wisp-uuid "e749c73d-c826-47e2-a798-c16c13cb89dd") =2D; define an intermediate dot replacement with UUID to avoid clashes. +;; define an intermediate dot replacement with UUID to avoid clashes. (define repr-dot ; . =2D (string->symbol (string-append "REPR-DOT-" wisp-uuid))) + (string->symbol (string-append "REPR-DOT-" wisp-uuid))) =20 =2D; allow using reader additions as the first element on a line to prefix = the list +;; allow using reader additions as the first element on a line to prefix t= he list (define repr-quote ; ' =2D (string->symbol (string-append "REPR-QUOTE-" wisp-uuid))) + (string->symbol (string-append "REPR-QUOTE-" wisp-uuid))) (define repr-unquote ; , =2D (string->symbol (string-append "REPR-UNQUOTE-" wisp-uuid))) + (string->symbol (string-append "REPR-UNQUOTE-" wisp-uuid))) (define repr-quasiquote ; ` =2D (string->symbol (string-append "REPR-QUASIQUOTE-" wisp-uuid))) + (string->symbol (string-append "REPR-QUASIQUOTE-" wisp-uuid))) (define repr-unquote-splicing ; ,@ =2D (string->symbol (string-append "REPR-UNQUOTESPLICING-" wisp-uuid)= )) + (string->symbol (string-append "REPR-UNQUOTESPLICING-" wisp-uuid))) =20 (define repr-syntax ; #' =2D (string->symbol (string-append "REPR-SYNTAX-" wisp-uuid))) + (string->symbol (string-append "REPR-SYNTAX-" wisp-uuid))) (define repr-unsyntax ; #, =2D (string->symbol (string-append "REPR-UNSYNTAX-" wisp-uuid))) + (string->symbol (string-append "REPR-UNSYNTAX-" wisp-uuid))) (define repr-quasisyntax ; #` =2D (string->symbol (string-append "REPR-QUASISYNTAX-" wisp-uuid))) + (string->symbol (string-append "REPR-QUASISYNTAX-" wisp-uuid))) (define repr-unsyntax-splicing ; #,@ =2D (string->symbol (string-append "REPR-UNSYNTAXSPLICING-" wisp-uuid= ))) + (string->symbol (string-append "REPR-UNSYNTAXSPLICING-" wisp-uuid))) =20 =2D; TODO: wrap the reader to return the repr of the syntax reader =2D; additions +;; TODO: wrap the reader to return the repr of the syntax reader +;; additions =20 (define (match-charlist-to-repr charlist) =2D (let =2D ((chlist (reverse charlist))) =2D (cond =2D ((equal? chlist (list #\.)) =2D repr-dot) =2D ((equal? chlist (list #\')) =2D repr-quote) =2D ((equal? chlist (list #\,)) =2D repr-unquote) =2D ((equal? chlist (list #\`)) =2D repr-quasiquote) =2D ((equal? chlist (list #\, #\@)) =2D repr-unquote-splicing) =2D ((equal? chlist (list #\# #\')) =2D repr-syntax) =2D ((equal? chlist (list #\# #\,)) =2D repr-unsyntax) =2D ((equal? chlist (list #\# #\`)) =2D repr-quasisyntax) =2D ((equal? chlist (list #\# #\, #\@)) =2D repr-unsyntax-splicing) =2D (else =2D #f)))) + (let + ((chlist (reverse charlist))) + (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)))) =20 (define (wisp-read port) =2D "wrap read to catch list prefixes." =2D (let ((prefix-maxlen 4)) =2D (let longpeek =2D ((peeked '()) =2D (repr-symbol #f)) =2D (cond =2D ((or (< prefix-maxlen (length peeked)) (eof-object? (peek-c= har port)) (equal? #\space (peek-char port)) (equal? #\newline (peek-char p= ort))) =2D (if repr-symbol ; found a special symbol, return it. =2D repr-symbol =2D (let unpeek =2D ((remaining peeked)) =2D (cond =2D ((equal? '() remaining) =2D (read port)); let read to the work =2D (else =2D (unread-char (car remaining) port) =2D (unpeek (cdr remaining))))))) =2D (else =2D (let* =2D ((next-char (read-char port)) =2D (peeked (cons next-char peeked))) =2D (longpeek =2D peeked =2D (match-charlist-to-repr peeked)))))))) + "wrap read to catch list prefixes." + (let ((prefix-maxlen 4)) + (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))) + (if repr-symbol ; found a special symbol, return it. + repr-symbol + (let unpeek + ((remaining peeked)) + (cond + ((equal? '() remaining) + (read port)); let read to the work + (else + (unread-char (car remaining) port) + (unpeek (cdr remaining))))))) + (else + (let* + ((next-char (read-char port)) + (peeked (cons next-char peeked))) + (longpeek + peeked + (match-charlist-to-repr peeked)))))))) =20 =20 =20 (define (line-continues? line) =2D (equal? repr-dot (car (line-code line)))) + (equal? repr-dot (car (line-code line)))) =20 (define (line-only-colon? line) =2D (and =2D (equal? ":" (car (line-code line))) =2D (null? (cdr (line-code line))))) + (and + (equal? ":" (car (line-code line))) + (null? (cdr (line-code line))))) =20 (define (line-empty-code? line) =2D (null? (line-code line))) + (null? (line-code line))) =20 (define (line-empty? line) =2D (and =2D ; if indent is -1, we stripped a comment, so the line was not= really empty. =2D (=3D 0 (line-indent line)) =2D (line-empty-code? line))) + (and + ;; if indent is -1, we stripped a comment, so the line was not really e= mpty. + (=3D 0 (line-indent line)) + (line-empty-code? line))) =20 (define (line-strip-continuation line) =2D (if (line-continues? line) =2D (append =2D (list =2D (line-indent line)) =2D (cdr (line-code line))) =2D line)) + (if (line-continues? line) + (apply make-line + (line-indent line) + (cdr (line-code line))) + line)) =20 (define (line-strip-indentation-marker line) =2D "Strip the indentation markers from the beginning of the line" =2D (cdr line)) + "Strip the indentation markers from the beginning of the line for line-f= inalize without propagating source-properties (those are propagated in a se= cond step)" + (cdr line)) =20 (define (indent-level-reduction indentation-levels level select-fun) =2D "Reduce the INDENTATION-LEVELS to the given LEVEL and return th= e value selected by SELECT-FUN" =2D (let loop =2D ((newlevels indentation-levels) =2D (diff 0)) =2D (cond =2D ((=3D level (car newlevels)) =2D (select-fun (list diff indentation-levels))) =2D ((< level (car newlevels)) =2D (loop =2D (cdr newlevels) =2D (1+ diff))) =2D (else =2D (throw 'wisp-syntax-error "Level ~A not found in the inde= ntation-levels ~A."))))) + "Reduce the INDENTATION-LEVELS to the given LEVEL and return the value s= elected by SELECT-FUN" + (let loop + ((newlevels indentation-levels) + (diff 0)) + (cond + ((=3D level (car newlevels)) + (select-fun (list diff indentation-levels))) + ((< level (car newlevels)) + (loop + (cdr newlevels) + (1+ diff))) + (else + (raise-exception (make-exception-from-throw 'wisp-syntax-error (list= (format #f "Level ~A not found in the indentation-levels ~A." level indent= ation-levels)))))))) =20 (define (indent-level-difference indentation-levels level) =2D "Find how many indentation levels need to be popped off to find= the given level." =2D (indent-level-reduction indentation-levels level =2D (lambda (x); get the count =2D (car x)))) + "Find how many indentation levels need to be popped off to find the give= n level." + (indent-level-reduction indentation-levels level + (lambda (x); get the count + (car x)))) =20 (define (indent-reduce-to-level indentation-levels level) =2D "Find how many indentation levels need to be popped off to find= the given level." =2D (indent-level-reduction indentation-levels level =2D (lambda (x); get the levels =2D (car (cdr x))))) + "Find how many indentation levels need to be popped off to find the give= n level." + (indent-level-reduction indentation-levels level + (lambda (x); get the levels + (car (cdr x))))) =20 (define (chunk-ends-with-period currentsymbols next-char) =2D "Check whether indent-and-symbols ends with a period, indicating = the end of a chunk." =2D (and (not (null? currentsymbols)) =2D (equal? #\newline next-char) =2D (equal? repr-dot =2D (list-ref currentsymbols (- (length currentsymbols) = 1))))) + "Check whether indent-and-symbols ends with a period, indicating the end= of a chunk." + (and (not (null? currentsymbols)) + (equal? #\newline next-char) + (equal? repr-dot + (list-ref currentsymbols (- (length currentsymbols) 1))))) + =20 (define (wisp-scheme-read-chunk-lines port) =2D (let loop =2D ((indent-and-symbols (list)); '((5 "(foobar)" "\"yobble\"")(3= "#t")) =2D (inindent #t) =2D (inunderscoreindent (equal? #\_ (peek-char port))) =2D (incomment #f) =2D (currentindent 0) =2D (currentsymbols '()) =2D (emptylines 0)) =2D (cond =2D ((>=3D emptylines 2); the chunk end has to be checked =2D ; before we look for new chars in the =2D ; port to make execution in the REPL =2D ; after two empty lines work =2D ; (otherwise it shows one more line). =2D indent-and-symbols) =2D (else =2D (let ((next-char (peek-char port))) =2D (cond =2D ((eof-object? next-char) =2D (append indent-and-symbols (list (append (list curren= tindent) currentsymbols)))) =2D ((and inindent (zero? currentindent) (not incomment) (n= ot (null? indent-and-symbols)) (not inunderscoreindent) (not (or (equal? #\= space next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) ne= xt-char)))) =2D (append indent-and-symbols)); top-level form ends chunk =2D ((chunk-ends-with-period currentsymbols next-char) =2D ; the line ends with a period. This is forbidden in =2D ; SRFI-119. Use it to end the line in the REPL without =2D ; showing continuation dots (...). =2D (append indent-and-symbols (list (append (list curren= tindent) (drop-right currentsymbols 1))))) =2D ((and inindent (equal? #\space next-char)) =2D (read-char port); remove char =2D (loop =2D indent-and-symbols =2D #t ; inindent =2D #f ; inunderscoreindent =2D #f ; incomment =2D (1+ currentindent) =2D currentsymbols =2D emptylines)) =2D ((and inunderscoreindent (equal? #\_ next-char)) =2D (read-char port); remove char =2D (loop =2D indent-and-symbols =2D #t ; inindent =2D #t ; inunderscoreindent =2D #f ; incomment =2D (1+ currentindent) =2D currentsymbols =2D emptylines)) =2D ; any char but whitespace *after* underscoreindent is =2D ; an error. This is stricter than the current wisp =2D ; syntax definition. TODO: Fix the definition. Better =2D ; start too strict. FIXME: breaks on lines with only =2D ; underscores which should be empty lines. =2D ((and inunderscoreindent (and (not (equal? #\space next= -char)) (not (equal? #\newline next-char)))) =2D (throw 'wisp-syntax-error "initial underscores withou= t following whitespace at beginning of the line after" (last indent-and-sym= bols))) =2D ((equal? #\newline next-char) =2D (read-char port); remove the newline =2D ; The following two lines would break the REPL by req= uiring one char too many. =2D ; if : and (equal? #\newline next-char) : equal? #\re= turn : peek-char port =2D ; read-char port ; remove a full \n\r. Damn spec= ial cases... =2D (let* ; distinguish pure whitespace lines and lines =2D ; with comment by giving the former zero =2D ; indent. Lines with a comment at zero indent =2D ; get indent -1 for the same reason - meaning =2D ; not actually empty. =2D ((indent =2D (cond =2D (incomment =2D (if (=3D 0 currentindent); specialcase =2D -1 =2D currentindent)) =2D ((not (null? currentsymbols)); pure whitespace =2D currentindent) =2D (else =2D 0))) =2D (parsedline (append (list indent) currentsymbols)) =2D (emptylines =2D (if (not (line-empty? parsedline)) =2D 0=20 =2D (1+ emptylines)))) =2D (when (not (=3D 0 (length parsedline))) =2D ; set the source properties to parsedline so we= can try to add them later. =2D (set-source-property! parsedline 'filename (por= t-filename port)) =2D (set-source-property! parsedline 'line (port-li= ne port))) =2D ; TODO: If the line is empty. Either do it here and= do not add it, just =2D ; increment the empty line counter, or strip it lat= er. Replace indent =2D ; -1 by indent 0 afterwards. =2D (loop =2D (append indent-and-symbols (list parsedline)) =2D #t ; inindent =2D (if (<=3D 2 emptylines) =2D #f ; chunk ends here =2D (equal? #\_ (peek-char port))); are we in under= score indent? =2D #f ; incomment =2D 0 =2D '() =2D emptylines))) =2D ((equal? #t incomment) =2D (read-char port); remove one comment character =2D (loop =2D indent-and-symbols =2D #f ; inindent=20 =2D #f ; inunderscoreindent=20 =2D #t ; incomment =2D currentindent =2D currentsymbols =2D emptylines)) =2D ((or (equal? #\space next-char) (equal? #\tab next-char= ) (equal? #\return next-char)); remove whitespace when not in indent =2D (read-char port); remove char =2D (loop =2D indent-and-symbols =2D #f ; inindent =2D #f ; inunderscoreindent =2D #f ; incomment =2D currentindent =2D currentsymbols =2D emptylines)) =2D ; | cludge to appease the former wisp parser =2D ; | used for bootstrapping which has a =2D ; v problem with the literal comment char =2D ((equal? (string-ref ";" 0) next-char) =2D (loop =2D indent-and-symbols =2D #f ; inindent =2D #f ; inunderscoreindent =2D #t ; incomment =2D currentindent =2D currentsymbols =2D emptylines)) =2D (else ; use the reader =2D (loop =2D indent-and-symbols =2D #f ; inindent =2D #f ; inunderscoreindent =2D #f ; incomment =2D currentindent =2D ; this also takes care of the hashbang and leading = comments. =2D (append currentsymbols (list (wisp-read port))) =2D emptylines)))))))) + (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 + ((>=3D emptylines 2) + ;; the chunk end has to be checked + ;; before we look for new chars in the + ;; port to make execution in the REPL + ;; after two empty lines work + ;; (otherwise it shows one more line). + indent-and-symbols) + (else + (let ((next-char (peek-char port))) + (cond + ((eof-object? next-char) + (append indent-and-symbols (list (apply make-line currentindent = currentsymbols)))) + ((and in-indent? (zero? currentindent) (not in-comment?) (not (nu= ll? indent-and-symbols)) (not in-underscoreindent?) (not (or (equal? #\spac= e next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) next-c= har)))) + (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 + ;; SRFI-119. Use it to end the line in the REPL without + ;; showing continuation dots (...). + (append indent-and-symbols (list (apply make-line currentindent = (drop-right currentsymbols 1))))) + ((and in-indent? (equal? #\space next-char)) + (read-char port); remove char + (loop + indent-and-symbols + #t ; in-indent? + #f ; in-underscoreindent? + #f ; in-comment? + (1+ currentindent) + currentsymbols + emptylines)) + ((and in-underscoreindent? (equal? #\_ next-char)) + (read-char port); remove char + (loop + indent-and-symbols + #t ; in-indent? + #t ; in-underscoreindent? + #f ; in-comment? + (1+ currentindent) + currentsymbols + 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. + ((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) + (read-char port); remove the newline + (let* + ;; distinguish pure whitespace lines and lines + ;; with comment by giving the former zero + ;; indent. Lines with a comment at zero indent + ;; get indent -1 for the same reason - meaning + ;; not actually empty. + ((indent + (cond + (in-comment? + (if (=3D 0 currentindent); specialcase + -1 + currentindent)) + ((not (null? currentsymbols)); pure whitespace + currentindent) + (else + 0))) + (parsedline (apply make-line indent currentsymbols)) + (emptylines + (if (not (line-empty? parsedline)) + 0 + (1+ emptylines)))) + (when (not (=3D 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 po= rt)) + (set-source-property! parsedline 'line (port-line port))) + ;; TODO: If the line is empty. Either do it here and do not ad= d it, just + ;; increment the empty line counter, or strip it later. Replac= e indent + ;; -1 by indent 0 afterwards. + (loop + (append indent-and-symbols (list parsedline)) + #t ; in-indent? + (if (<=3D 2 emptylines) + #f ; chunk ends here + (equal? #\_ (peek-char port))); are we in underscore inde= nt? + #f ; in-comment? + 0 + '() + emptylines))) + ((equal? #t in-comment?) + (read-char port); remove one comment character + (loop + indent-and-symbols + #f ; in-indent? + #f ; in-underscoreindent? + #t ; in-comment? + currentindent + currentsymbols + emptylines)) + ((or (equal? #\space next-char) (equal? #\tab next-char) (equal? = #\return next-char)); remove whitespace when not in indent + (read-char port); remove char + (loop + indent-and-symbols + #f ; in-indent? + #f ; in-underscoreindent? + #f ; in-comment? + currentindent + currentsymbols + emptylines)) + ;; | cludge to appease the former wisp parser + ;; | used for bootstrapping which has a + ;; v problem with the literal comment char + ((equal? (string-ref ";" 0) next-char) + (loop + indent-and-symbols + #f ; in-indent? + #f ; in-underscoreindent? + #t ; in-comment? + currentindent + currentsymbols + emptylines)) + (else ; use the reader + (loop + indent-and-symbols + #f ; in-indent? + #f ; in-underscoreindent? + #f ; in-comment? + currentindent + ;; this also takes care of the hashbang and leading comments. + (append currentsymbols (list (wisp-read port))) + emptylines)))))))) =20 =20 (define (line-code-replace-inline-colons line) =2D "Replace inline colons by opening parens which close at the end= of the line" =2D ; format #t "replace inline colons for line ~A\n" line =2D (let loop =2D ((processed '()) =2D (unprocessed line)) =2D (cond =2D ((null? unprocessed) =2D ; format #t "inline-colons processed line: ~A\n" processed =2D processed) =2D ; replace : . with nothing =2D ((and (<=3D 2 (length unprocessed)) (equal? readcolon (car = unprocessed)) (equal? repr-dot (car (cdr unprocessed)))) =2D (loop =2D (append processed =2D (loop '() (cdr (cdr unprocessed)))) =2D '())) =2D ((equal? readcolon (car unprocessed)) =2D (loop =2D ; FIXME: This should turn unprocessed into a list.=20 =2D (append processed =2D (list (loop '() (cdr unprocessed)))) =2D '())) =2D (else =2D (loop =2D (append processed =2D (list (car unprocessed))) =2D (cdr unprocessed)))))) + "Replace inline colons by opening parens which close at the end of the l= ine" + ;; format #t "replace inline colons for line ~A\n" line + (let loop + ((processed '()) + (unprocessed line)) + (cond + ((null? unprocessed) + ;; format #t "inline-colons processed line: ~A\n" processed + processed) + ;; replace : . with nothing + ((and (<=3D 2 (length unprocessed)) (equal? readcolon (car unprocesse= d)) (equal? repr-dot (car (cdr unprocessed)))) + (loop + (append processed + (loop '() (cdr (cdr unprocessed)))) + '())) + ((equal? readcolon (car unprocessed)) + (loop + (append processed + (list (loop '() (cdr unprocessed)))) + '())) + (else + (loop + (append processed + (list (car unprocessed))) + (cdr unprocessed)))))) =20 (define (line-replace-inline-colons line) =2D (cons =2D (line-indent line) =2D (line-code-replace-inline-colons (line-code line)))) + (cons + (line-indent line) + (line-code-replace-inline-colons (line-code line)))) =20 (define (line-strip-lone-colon line) =2D "A line consisting only of a colon is just a marked indentation= level. We need to kill the colon before replacing inline colons." =2D (if =2D (equal? =2D (line-code line) =2D (list readcolon)) =2D (list (line-indent line)) =2D line)) + "A line consisting only of a colon is just a marked indentation level. W= e need to kill the colon before replacing inline colons." + (if (equal? (line-code line) (list readcolon)) + (make-line (line-indent line)) + line)) =20 (define (line-finalize line) =2D "Process all wisp-specific information in a line and strip it" =2D (let ((l (line-code-replace-inline-colons =2D (line-strip-indentation-marker =2D (line-strip-lone-colon =2D (line-strip-continuation line)))))) =2D (when (not (null? (source-properties line))) =2D (catch #t =2D (lambda () =2D (set-source-properties! l (source-properties line))) =2D (lambda (key . arguments) =2D #f))) =2D l)) + "Process all wisp-specific information in a line and strip it" + (let ((l (line-code-replace-inline-colons + (line-strip-indentation-marker + (line-strip-lone-colon + (line-strip-continuation line)))))) + (when (not (null? (source-properties line))) + (catch #t + (lambda () + (set-source-properties! l (source-properties line))) + (lambda (key . arguments) + #f))) + l)) =20 (define (wisp-add-source-properties-from source target) =2D "Copy the source properties from source into the target and retur= n the target." =2D (catch #t =2D (lambda () =2D (set-source-properties! target (source-properties source)= )) =2D (lambda (key . arguments) =2D #f)) =2D target) + "Copy the source properties from source into the target and return the t= arget." + (catch #t + (lambda () + (set-source-properties! target (source-properties source))) + (lambda (key . arguments) + #f)) + target) =20 (define (wisp-propagate-source-properties code) =2D "Propagate the source properties from the sourrounding list into = every part of the code." =2D (let loop =2D ((processed '()) =2D (unprocessed code)) =2D (cond =2D ((and (null? processed) (not (pair? unprocessed)) (not (list?= unprocessed))) =2D unprocessed) =2D ((and (pair? unprocessed) (not (list? unprocessed))) =2D (cons =2D (wisp-propagate-source-properties (car unprocessed)) =2D (wisp-propagate-source-properties (cdr unprocessed)))) =2D ((null? unprocessed) =2D processed) =2D (else =2D (let ((line (car unprocessed))) =2D (if (null? (source-properties unprocessed)) =2D (wisp-add-source-properties-from line unprocessed) =2D (wisp-add-source-properties-from unprocessed line)) =2D (loop =2D (append processed (list (wisp-propagate-source-properti= es line))) =2D (cdr unprocessed))))))) + "Propagate the source properties from the sourrounding list into every p= art of the code." + (let loop + ((processed '()) + (unprocessed code)) + (cond + ((and (null? processed) (not (pair? unprocessed)) (not (list? unproce= ssed))) + unprocessed) + ((and (pair? unprocessed) (not (list? unprocessed))) + (cons + (wisp-propagate-source-properties (car unprocessed)) + (wisp-propagate-source-properties (cdr unprocessed)))) + ((null? unprocessed) + processed) + (else + (let ((line (car unprocessed))) + (if (null? (source-properties unprocessed)) + (wisp-add-source-properties-from line unprocessed) + (wisp-add-source-properties-from unprocessed line)) + (loop + (append processed (list (wisp-propagate-source-properties line))) + (cdr unprocessed))))))) =20 (define* (wisp-scheme-indentation-to-parens lines) =2D "Add parentheses to lines and remove the indentation markers" =2D (when =2D (and =2D (not (null? lines)) =2D (not (line-empty-code? (car lines))) =2D (not (=3D 0 (line-real-indent (car lines))))); -1 is a line= with a comment =2D (if (=3D 1 (line-real-indent (car lines))) =2D ;; accept a single space as indentation of the first line (= and ignore the indentation) to support meta commands =2D (set! lines =2D (cons =2D (cons 0 (cdr (car lines))) =2D (cdr lines))) =2D (throw 'wisp-syntax-error + "Add parentheses to lines and remove the indentation markers" + (when + (and + (not (null? lines)) + (not (line-empty-code? (car lines))) + (not (=3D 0 (line-real-indent (car lines))))); -1 is a line with a = comment + (if (=3D 1 (line-real-indent (car lines))) + ;; accept a single space as indentation of the first line (and ign= ore the indentation) to support meta commands + (set! lines + (cons + (cons 0 (cdr (car lines))) + (cdr lines))) + (raise-exception (make-exception-from-throw 'wisp-syntax-error (li= st (format #f "The first symbol in a chunk must start at zero = indentation. Indentation and line: ~A" =2D (car lines))))) =2D (let loop =2D ((processed '()) =2D (unprocessed lines) =2D (indentation-levels '(0))) =2D (let* =2D ((current-line =2D (if (<=3D 1 (length unprocessed)) =2D (car unprocessed) =2D (list 0))); empty code =2D (next-line =2D (if (<=3D 2 (length unprocessed)) =2D (car (cdr unprocessed)) =2D (list 0))); empty code =2D (current-indentation =2D (car indentation-levels)) =2D (current-line-indentation (line-real-indent current-line)= )) =2D ; format #t "processed: ~A\ncurrent-line: ~A\nnext-line: ~A= \nunprocessed: ~A\nindentation-levels: ~A\ncurrent-indentation: ~A\n\n" =2D ; . processed current-line next-line unprocessed indent= ation-levels current-indentation =2D (cond =2D ; the real end: this is reported to the outside world. =2D ((and (null? unprocessed) (not (null? indentation-levels)= ) (null? (cdr indentation-levels))) =2D ; display "done\n" =2D ; reverse the processed lines, because I use cons. =2D processed) =2D ; the recursion end-condition =2D ((and (null? unprocessed)) =2D ; display "last step\n" =2D ; this is the last step. Nothing more to do except =2D ; for rolling up the indentation levels. return the =2D ; new processed and unprocessed lists: this is a =2D ; side-recursion =2D (values processed unprocessed)) =2D ((null? indentation-levels) =2D ; display "indentation-levels null\n" =2D (throw 'wisp-programming-error "The indentation-levels = are null but the current-line is null: Something killed the indentation-lev= els.")) =2D (else ; now we come to the line-comparisons and indentati= on-counting. =2D (cond =2D ((line-empty-code? current-line) =2D ; display "current-line empty\n" =2D ; We cannot process indentation without =2D ; code. Just switch to the next line. This should =2D ; only happen at the start of the recursion. =2D ; TODO: Somehow preserve the line-numbers. =2D (loop =2D processed =2D (cdr unprocessed) =2D indentation-levels)) =2D ((and (line-empty-code? next-line) (<=3D 2 (length = unprocessed))) =2D ; display "next-line empty\n" =2D ; TODO: Somehow preserve the line-numbers. =2D ; take out the next-line from unprocessed. =2D (loop =2D processed =2D (cons current-line =2D (cdr (cdr unprocessed))) =2D indentation-levels)) =2D ((> current-indentation current-line-indentation) =2D ; display "current-indent > next-line\n" =2D ; this just steps back one level via the side-rec= ursion. =2D (let ((previous-indentation (car (cdr indentation= -levels)))) =2D (if (<=3D current-line-indentation previous-ind= entation) =2D (values processed unprocessed) =2D (begin ;; not yet used level! TODO: maybe th= row an error here instead of a warning. =2D (let ((linenumber (- (length lines) (len= gth unprocessed)))) =2D (format (current-error-port) ";;; WA= RNING:~A: used lower but undefined indentation level (line ~A of the curren= t chunk: ~S). This makes refactoring much more error-prone, therefore it mi= ght become an error in a later version of Wisp.\n" (source-property current= -line 'line) linenumber (cdr current-line))) =2D (loop =2D processed =2D unprocessed =2D (cons ; recursion via the indentation-= levels =2D current-line-indentation =2D (cdr indentation-levels))))))) =2D ((=3D current-indentation current-line-indentation) =2D ; display "current-indent =3D next-line\n" =2D (let =2D ((line (line-finalize current-line)) =2D (next-line-indentation (line-real-indent next= -line))) =2D (cond =2D ((>=3D current-line-indentation next-line-ind= entation) =2D ; simple recursiive step to the next line =2D ; display "current-line-indent >=3D next-li= ne-indent\n" =2D (loop =2D (append processed =2D (if (line-continues? current-line) =2D line =2D (wisp-add-source-properties-from l= ine (list line)))) =2D (cdr unprocessed); recursion here =2D indentation-levels)) =2D ((< current-line-indentation next-line-indent= ation) =2D ; display "current-line-indent < next-line-= indent\n" =2D ; format #t "line: ~A\n" line =2D ; side-recursion via a sublist =2D (let-values =2D (((sub-processed sub-unprocessed) =2D (loop =2D line =2D (cdr unprocessed); recursion here =2D indentation-levels))) =2D ; format #t "side-recursion:\n sub-proce= ssed: ~A\n processed: ~A\n\n" sub-processed processed =2D (loop =2D (append processed (list sub-processed)) =2D sub-unprocessed ; simply use the recurs= ion from the sub-recursion =2D indentation-levels)))))) =2D ((< current-indentation current-line-indentation) =2D ; display "current-indent < next-line\n" =2D (loop =2D processed =2D unprocessed =2D (cons ; recursion via the indentation-levels =2D current-line-indentation =2D indentation-levels))) =2D (else =2D (throw 'wisp-not-implemented =2D (format #f "Need to implement further line = comparison: current: ~A, next: ~A, processed: ~A." =2D current-line next-line processed))))))))) + (car lines))))))) + (let loop + ((processed '()) + (unprocessed lines) + (indentation-levels '(0))) + (let* + ((current-line + (if (<=3D 1 (length unprocessed)) + (car unprocessed) + (make-line 0))); empty code + (next-line + (if (<=3D 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\nunproc= essed: ~A\nindentation-levels: ~A\ncurrent-indentation: ~A\n\n" + ;; . processed current-line next-line unprocessed indentation-le= vels current-indentation + (cond + ;; the real end: this is reported to the outside world. + ((and (null? unprocessed) (not (null? indentation-levels)) (null? (= cdr indentation-levels))) + ;; reverse the processed lines, because I use cons. + processed) + ;; the recursion end-condition + ((and (null? unprocessed)) + ;; this is the last step. Nothing more to do except + ;; for rolling up the indentation levels. return the + ;; new processed and unprocessed lists: this is a + ;; side-recursion + (values processed unprocessed)) + ((null? indentation-levels) + (raise-exception (make-exception-from-throw 'wisp-programming-erro= r (list "The indentation-levels are null but the current-line is null: Som= ething killed the indentation-levels.")))) + (else ; now we come to the line-comparisons and indentation-countin= g. + (cond + ((line-empty-code? current-line) + ;; We cannot process indentation without + ;; code. Just switch to the next line. This should + ;; only happen at the start of the recursion. + (loop + processed + (cdr unprocessed) + indentation-levels)) + ((and (line-empty-code? next-line) (<=3D 2 (length unprocessed))) + ;; take out the next-line from unprocessed. + (loop + processed + (cons current-line + (cdr (cdr unprocessed))) + indentation-levels)) + ((> current-indentation current-line-indentation) + ;; this just steps back one level via the side-recursion. + (let ((previous-indentation (car (cdr indentation-levels)))) + (if (<=3D current-line-indentation previous-indentation) + (values processed unprocessed) + (begin ;; not yet used level! TODO: maybe throw an error h= ere instead of a warning. + (let ((linenumber (- (length lines) (length unprocessed)= ))) + (format (current-error-port) ";;; WARNING:~A: used low= er but undefined indentation level (line ~A of the current chunk: ~S). This= makes refactoring much more error-prone, therefore it might become an erro= r in a later version of Wisp.\n" (source-property current-line 'line) linen= umber (cdr current-line))) + (loop + processed + unprocessed + (cons ; recursion via the indentation-levels + current-line-indentation + (cdr indentation-levels))))))) + ((=3D current-indentation current-line-indentation) + (let + ((line (line-finalize current-line)) + (next-line-indentation (line-real-indent next-line))) + (cond + ((>=3D current-line-indentation next-line-indentation) + ;; simple recursiive step to the next line + (loop + (append processed + (if (line-continues? current-line) + line + (wisp-add-source-properties-from line (list lin= e)))) + (cdr unprocessed); recursion here + indentation-levels)) + ((< current-line-indentation next-line-indentation) + ;; side-recursion via a sublist + (let-values + (((sub-processed sub-unprocessed) + (loop + line + (cdr unprocessed); recursion here + indentation-levels))) + (loop + (append processed (list sub-processed)) + sub-unprocessed ; simply use the recursion from the sub-r= ecursion + indentation-levels)))))) + ((< current-indentation current-line-indentation) + (loop + processed + unprocessed + (cons ; recursion via the indentation-levels + current-line-indentation + indentation-levels))) + (else + (raise-exception (make-exception-from-throw 'wisp-not-implemente= d (list + (format #f "Need to implement further line comparison: cu= rrent: ~A, next: ~A, processed: ~A." + current-line next-line processed))))))))))) =20 =20 (define (wisp-scheme-replace-inline-colons lines) =2D "Replace inline colons by opening parens which close at the end= of the line" =2D (let loop =2D ((processed '()) =2D (unprocessed lines)) =2D (if (null? unprocessed) =2D processed =2D (loop =2D (append processed (list (line-replace-inline-colons (c= ar unprocessed)))) =2D (cdr unprocessed))))) + "Replace inline colons by opening parens which close at the end of the l= ine" + (let loop + ((processed '()) + (unprocessed lines)) + (if (null? unprocessed) + processed + (loop + (append processed (list (line-replace-inline-colons (car unproces= sed)))) + (cdr unprocessed))))) =20 =20 (define (wisp-scheme-strip-indentation-markers lines) =2D "Strip the indentation markers from the beginning of the lines" =2D (let loop =2D ((processed '()) =2D (unprocessed lines)) =2D (if (null? unprocessed) =2D processed =2D (loop =2D (append processed (cdr (car unprocessed))) =2D (cdr unprocessed))))) + "Strip the indentation markers from the beginning of the lines" + (let loop + ((processed '()) + (unprocessed lines)) + (if (null? unprocessed) + processed + (loop + (append processed (cdr (car unprocessed))) + (cdr unprocessed))))) =20 (define (wisp-unescape-underscore-and-colon code) "replace \\_ and \\: by _ and :" (cond ((list? code) (map wisp-unescape-underscore-and-colon code)) =2D ((eq? code '\:) ':) =2D ;; Look for symbols like \____ and remove the \. =2D ((symbol? code) =2D (let ((as-string (symbol->string code))) =2D (if (and (>=3D (string-length as-string) 2) ; at least a single= underscore =2D (char=3D? (string-ref as-string 0) #\\) =2D (string-every #\_ (substring as-string 1))) =2D (string->symbol (substring as-string 1)) =2D code))) =2D (#t code))) + ((eq? code '\:) ':) + ;; Look for symbols like \____ and remove the \. + ((symbol? code) + (let ((as-string (symbol->string code))) + (if (and (>=3D (string-length as-string) 2) ; at least a single= underscore + (char=3D? (string-ref as-string 0) #\\) + (string-every #\_ (substring as-string 1))) + (string->symbol (substring as-string 1)) + code))) + (#t code))) =20 =20 (define (wisp-replace-empty-eof code) =2D "replace ((#)) by ()" =2D ; FIXME: Actually this is a hack which fixes a bug when the =2D ; parser hits files with only hashbang and comments. =2D (if (and (not (null? code)) (pair? (car code)) (eof-object? (ca= r (car code))) (null? (cdr code)) (null? (cdr (car code)))) =2D (list) =2D code)) + "replace ((#)) by ()" + ;; This is a hack which fixes a bug when the + ;; parser hits files with only hashbang and comments. + (if (and (not (null? code)) (pair? (car code)) (eof-object? (car (car co= de))) (null? (cdr code)) (null? (cdr (car code)))) + (list) + code)) =20 =20 (define (wisp-replace-paren-quotation-repr code) =2D "Replace lists starting with a quotation symbol by + "Replace lists starting with a quotation symbol by quoted lists." =2D (match code =2D (('REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'quote (map wisp-replace-paren-quotation-repr a))) =2D ((a ... 'REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b)= ; this is the quoted empty list=20 =2D (append =2D (map wisp-replace-paren-quotation-repr a) =2D (list (list 'quote (map wisp-replace-paren-quota= tion-repr b))))) =2D (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd 'RE= PR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'quasiquote (list 'unquote (map wisp-replace-paren= -quotation-repr a)))) =2D (('REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'unquote (map wisp-replace-paren-quotation-repr a)= )) =2D ((a ... 'REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd = b) =2D (append =2D (map wisp-replace-paren-quotation-repr a) =2D (list (list 'unquote (map wisp-replace-paren-quo= tation-repr b))))) =2D (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a .= ..) =2D (list 'quasiquote (map wisp-replace-paren-quotation-repr= a))) =2D ((a ... 'REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89= dd b); this is the quoted empty list=20 =2D (append =2D (map wisp-replace-paren-quotation-repr a) =2D (list (list 'quasiquote (map wisp-replace-paren-= quotation-repr b))))) =2D (('REPR-UNQUOTESPLICING-e749c73d-c826-47e2-a798-c16c13cb89d= d a ...) =2D (list 'unquote-splicing (map wisp-replace-paren-quotatio= n-repr a))) =2D (('REPR-SYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'syntax (map wisp-replace-paren-quotation-repr a))) =2D (('REPR-UNSYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'unsyntax (map wisp-replace-paren-quotation-repr a= ))) =2D (('REPR-QUASISYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a = ...) =2D (list 'quasisyntax (map wisp-replace-paren-quotation-rep= r a))) =2D (('REPR-UNSYNTAXSPLICING-e749c73d-c826-47e2-a798-c16c13cb89= dd a ...) =2D (list 'unsyntax-splicing (map wisp-replace-paren-quotati= on-repr a))) =2D ;; literal array as start of a line: # (a b) c -> (#(a b) c) =2D ((#\# a ...) =2D (with-input-from-string ;; hack to defer to read =2D (string-append "#" =2D (with-output-to-string =2D (=CE=BB () =2D (write (map wisp-replace-paren-quotation-re= pr a) =2D (current-output-port))))) =2D read)) =2D ((a ...) =2D (map wisp-replace-paren-quotation-repr a)) =2D (a =2D a))) + (match code + (('REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'quote (map wisp-replace-paren-quotation-repr a))) + ((a ... 'REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b); this is t= he quoted empty list + (append + (map wisp-replace-paren-quotation-repr a) + (list (list 'quote (map wisp-replace-paren-quotation-repr b))))) + (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd 'REPR-UNQUOTE-= e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'quasiquote (list 'unquote (map wisp-replace-paren-quotation-re= pr a)))) + (('REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'unquote (map wisp-replace-paren-quotation-repr a))) + ((a ... 'REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b) + (append + (map wisp-replace-paren-quotation-repr a) + (list (list 'unquote (map wisp-replace-paren-quotation-repr b))))) + (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'quasiquote (map wisp-replace-paren-quotation-repr a))) + ((a ... 'REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b); this= is the quoted empty list + (append + (map wisp-replace-paren-quotation-repr a) + (list (list 'quasiquote (map wisp-replace-paren-quotation-repr b))))) + (('REPR-UNQUOTESPLICING-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'unquote-splicing (map wisp-replace-paren-quotation-repr a))) + (('REPR-SYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'syntax (map wisp-replace-paren-quotation-repr a))) + (('REPR-UNSYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'unsyntax (map wisp-replace-paren-quotation-repr a))) + (('REPR-QUASISYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'quasisyntax (map wisp-replace-paren-quotation-repr a))) + (('REPR-UNSYNTAXSPLICING-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'unsyntax-splicing (map wisp-replace-paren-quotation-repr a))) + ;; literal array as start of a line: # (a b) c -> (#(a b) c) + ((#\# a ...) + (with-input-from-string ;; hack to defer to read + (string-append "#" + (with-output-to-string + (=CE=BB () + (write (map wisp-replace-paren-quotation-repr = a) + (current-output-port))))) + read)) + ((a ...) + (map wisp-replace-paren-quotation-repr a)) + (a + a))) =20 (define (wisp-make-improper code) =2D "Turn (a #{.}# b) into the correct (a . b). + "Turn (a #{.}# b) into the correct (a . b). =20 read called on a single dot creates a variable named #{.}# (|.| in r7rs). Due to parsing the indentation before the list @@ -676,86 +660,85 @@ when it reads a dot. So we have to take another pass = over the code to recreate the improper lists. =20 Match is awesome!" =2D (let =2D ((improper =2D (match code =2D ((a ... b 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89= dd c) =2D (append (map wisp-make-improper a)=20 =2D (cons (wisp-make-improper b) (wisp-make-improper c= )))) =2D ((a ...) =2D (map wisp-make-improper a)) =2D (a =2D a)))) =2D (define (syntax-error li msg) =2D (throw 'wisp-syntax-error (format #f "incorrect dot-s= yntax #{.}# in code: ~A: ~A" msg li))) =2D (if #t =2D improper =2D (let check =2D ((tocheck improper)) =2D (match tocheck =2D ; lists with only one member =2D (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) =2D (syntax-error tocheck "list with the period as only mem= ber")) =2D ; list with remaining dot. =2D ((a ...) =2D (if (and (member repr-dot a)) =2D (syntax-error tocheck "leftover period in list") =2D (map check a))) =2D ; simple pair - this and the next do not work when parsed= from wisp-scheme itself. Why? =2D (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd . c) =2D (syntax-error tocheck "dot as first element in already = improper pair")) =2D ; simple pair, other way round =2D ((a . 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) =2D (syntax-error tocheck "dot as last element in already i= mproper pair")) =2D ; more complex pairs =2D ((? pair? a) =2D (let=20 =2D ((head (drop-right a 1)) =2D (tail (last-pair a))) =2D (cond =2D ((equal? repr-dot (car tail)) =2D (syntax-error tocheck "equal? repr-dot : car tail"= )) =2D ((equal? repr-dot (cdr tail)) =2D (syntax-error tocheck "equal? repr-dot : cdr tail"= )) =2D ((member repr-dot head) =2D (syntax-error tocheck "member repr-dot head")) =2D (else =2D a)))) =2D (a =2D a)))))) + (let + ((improper + (match code + ((a ... b 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd c) + (append (map wisp-make-improper a) + (cons (wisp-make-improper b) (wisp-make-improper c)))) + ((a ...) + (map wisp-make-improper a)) + (a + a)))) + (define (syntax-error li msg) + (raise-exception (make-exception-from-throw 'wisp-syntax-error (list= (format #f "incorrect dot-syntax #{.}# in code: ~A: ~A" msg li))))) + (if #t + improper + (let check + ((tocheck improper)) + (match tocheck + ;; lists with only one member + (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) + (syntax-error tocheck "list with the period as only member")) + ;; list with remaining dot. + ((a ...) + (if (and (member repr-dot a)) + (syntax-error tocheck "leftover period in list") + (map check a))) + ;; simple pair - this and the next do not work when parsed fro= m wisp-scheme itself. Why? + (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd . c) + (syntax-error tocheck "dot as first element in already improp= er pair")) + ;; simple pair, other way round + ((a . 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) + (syntax-error tocheck "dot as last element in already imprope= r pair")) + ;; more complex pairs + ((? 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")) + ((equal? repr-dot (cdr tail)) + (syntax-error tocheck "equal? repr-dot : cdr tail")) + ((member repr-dot head) + (syntax-error tocheck "member repr-dot head")) + (else + a)))) + (a + a)))))) =20 (define (wisp-scheme-read-chunk port) =2D "Read and parse one chunk of wisp-code" =2D (with-fluids ((%read-hash-procedures (fluid-ref %read-hash-procedure= s))) =2D (read-hash-extend #\# (lambda args #\#)) =2D (let ((lines (wisp-scheme-read-chunk-lines port))) =2D (wisp-make-improper =2D (wisp-replace-empty-eof =2D (wisp-unescape-underscore-and-colon =2D (wisp-replace-paren-quotation-repr =2D (wisp-propagate-source-properties =2D (wisp-scheme-indentation-to-parens lines))))))))) + "Read and parse one chunk of wisp-code" + (with-fluids ((%read-hash-procedures (fluid-ref %read-hash-procedures))) + (read-hash-extend #\# (lambda args #\#)) + (let ((lines (wisp-scheme-read-chunk-lines port))) + (wisp-make-improper + (wisp-replace-empty-eof + (wisp-unescape-underscore-and-colon + (wisp-replace-paren-quotation-repr + (wisp-propagate-source-properties + (wisp-scheme-indentation-to-parens lines))))))))) =20 (define (wisp-scheme-read-all port) =2D "Read all chunks from the given port" =2D (let loop =2D ((tokens '())) =2D (cond =2D ((eof-object? (peek-char port)) =2D tokens) =2D (else =2D (loop =2D (append tokens (wisp-scheme-read-chunk port))))))) + "Read all chunks from the given port" + (let loop + ((tokens '())) + (cond + ((eof-object? (peek-char port)) + tokens) + (else + (loop + (append tokens (wisp-scheme-read-chunk port))))))) =20 (define (wisp-scheme-read-file path) =2D (call-with-input-file path wisp-scheme-read-all)) + (call-with-input-file path wisp-scheme-read-all)) =20 (define (wisp-scheme-read-file-chunk path) =2D (call-with-input-file path wisp-scheme-read-chunk)) + (call-with-input-file path wisp-scheme-read-chunk)) =20 (define (wisp-scheme-read-string str) =2D (call-with-input-string str wisp-scheme-read-all)) + (call-with-input-string str wisp-scheme-read-all)) =20 (define (wisp-scheme-read-string-chunk str) =2D (call-with-input-string str wisp-scheme-read-chunk)) =2D + (call-with-input-string str wisp-scheme-read-chunk)) =2D-=20 2.41.0 From=208bacc9f43c3c5ffe1634a4e3fadda90ce4bdebcc Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Sat, 12 Aug 2023 23:13:26 +0200 Subject: [PATCH 07/11] SRFI-119 (wisp): change lang enter message * module/language/wisp/spec.scm (define-language): no period at end, because the actual message in the REPL adds a ! =2D-- 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 fde08b429..e6dbf1764 100644 =2D-- a/module/language/wisp/spec.scm +++ b/module/language/wisp/spec.scm @@ -51,7 +51,7 @@ (car chunk)))))) =20 (define-language wisp =2D #:title "Wisp Scheme Syntax. See SRFI-119 for details." + #:title "Wisp Scheme Syntax. See SRFI-119 for details" ; . #:reader read-one-wisp-sexp #:reader read-one-wisp-sexp ; : lambda (port env) : let ((x (read-one-wi= sp-sexp port env))) (display x)(newline) x ; #:compilers `((tree-il . ,compile-tree-il)) =2D-=20 2.41.0 From=20e79472e185027316b8195c8fbe502bd0c819fcaa Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Sat, 12 Aug 2023 23:17:57 +0200 Subject: [PATCH 08/11] SRFI-119 (wisp): simplify for review * module/language/wisp/spec.scm (define-language): do not set simple-format as formatter for the reader =2D-- module/language/wisp/spec.scm | 5 ----- 1 file changed, 5 deletions(-) diff --git a/module/language/wisp/spec.scm b/module/language/wisp/spec.scm index e6dbf1764..1efd3e8b2 100644 =2D-- a/module/language/wisp/spec.scm +++ b/module/language/wisp/spec.scm @@ -67,11 +67,6 @@ ;; compile-time changes to `current-reader' are ;; limited to the current compilation unit. (module-define! m 'current-reader (make-fluid)) =2D ;; Default to `simple-format', as is the case until =2D ;; (ice-9 format) is loaded. This allows =2D ;; compile-time warnings to be emitted when using =2D ;; unsupported options. =2D (module-set! m 'format simple-format) m))) =20 =20 =2D-=20 2.41.0 From=205cd837c71683dd5de51837f859450dcdbc99d83e Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Sun, 13 Aug 2023 11:35:23 +0200 Subject: [PATCH 09/11] SRFI-119 (wisp): Add source-property tests * module/language/wisp.scm (wisp-add-source-properties-from/when-required): add the source properties from source to target if target has no source-properties. * module/language/wisp.scm (wisp-propagate-source-properties): fix source property propagation * module/language/wisp.scm (wisp-scheme-read-chunk-lines wisp-unescape-underscore-and-colon wisp-unescape-underscore-and-colon wisp-replace-paren-quotation-repr wisp-make-improper): preserve source properties * test-suite/tests/srfi-119.test (top-level): add testgroup wisp-source-properties =2D-- module/language/wisp.scm | 181 +++++++++++++++++++-------------- test-suite/tests/srfi-119.test | 10 +- 2 files changed, 114 insertions(+), 77 deletions(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index acc1f0725..812a8bad0 100644 =2D-- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -234,7 +234,10 @@ (let ((next-char (peek-char port))) (cond ((eof-object? next-char) =2D (append indent-and-symbols (list (apply make-line currentinden= t currentsymbols)))) + (let ((line (apply make-line currentindent currentsymbols))) + (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 (nu= ll? indent-and-symbols)) (not in-underscoreindent?) (not (or (equal? #\spac= e next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) next-c= har)))) (append indent-and-symbols)); top-level form ends chunk ((chunk-ends-with-period currentsymbols next-char) @@ -414,6 +417,12 @@ #f)) target) =20 +(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 p= art of the code." (let loop @@ -430,12 +439,15 @@ processed) (else (let ((line (car unprocessed))) =2D (if (null? (source-properties unprocessed)) =2D (wisp-add-source-properties-from line unprocessed) =2D (wisp-add-source-properties-from unprocessed line)) =2D (loop =2D (append processed (list (wisp-propagate-source-properties line)= )) =2D (cdr unprocessed))))))) + (wisp-add-source-properties-from/when-required line unprocessed) + (wisp-add-source-properties-from/when-required code unprocessed) + (wisp-add-source-properties-from/when-required unprocessed line) + (wisp-add-source-properties-from/when-required unprocessed code) + (let ((processed (append processed (list (wisp-propagate-source-pr= operties line))))) + ;; must propagate from line, because unprocessed and code can be= null, then they cannot keep source-properties. + (wisp-add-source-properties-from/when-required line processed) + (loop processed + (cdr unprocessed)))))))) =20 (define* (wisp-scheme-indentation-to-parens lines) "Add parentheses to lines and remove the indentation markers" @@ -580,17 +592,19 @@ =20 (define (wisp-unescape-underscore-and-colon code) "replace \\_ and \\: by _ and :" =2D (cond ((list? code) (map wisp-unescape-underscore-and-colon code)) =2D ((eq? code '\:) ':) =2D ;; Look for symbols like \____ and remove the \. =2D ((symbol? code) =2D (let ((as-string (symbol->string code))) =2D (if (and (>=3D (string-length as-string) 2) ; at least a sing= le underscore =2D (char=3D? (string-ref as-string 0) #\\) =2D (string-every #\_ (substring as-string 1))) =2D (string->symbol (substring as-string 1)) =2D code))) =2D (#t code))) + (wisp-add-source-properties-from/when-required + code + (cond ((list? code) (map wisp-unescape-underscore-and-colon code)) + ((eq? code '\:) ':) + ;; Look for symbols like \____ and remove the \. + ((symbol? code) + (let ((as-string (symbol->string code))) + (if (and (>=3D (string-length as-string) 2) ; at least a singl= e underscore + (char=3D? (string-ref as-string 0) #\\) + (string-every #\_ (substring as-string 1))) + (string->symbol (substring as-string 1)) + code))) + (#t code)))) =20 =20 (define (wisp-replace-empty-eof code) @@ -598,57 +612,59 @@ ;; This is a hack which fixes a bug when the ;; parser hits files with only hashbang and comments. (if (and (not (null? code)) (pair? (car code)) (eof-object? (car (car co= de))) (null? (cdr code)) (null? (cdr (car code)))) =2D (list) + (wisp-add-source-properties-from code (list)) code)) =20 =20 (define (wisp-replace-paren-quotation-repr code) "Replace lists starting with a quotation symbol by quoted lists." =2D (match code =2D (('REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'quote (map wisp-replace-paren-quotation-repr a))) =2D ((a ... 'REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b); this is= the quoted empty list =2D (append =2D (map wisp-replace-paren-quotation-repr a) =2D (list (list 'quote (map wisp-replace-paren-quotation-repr b))))) =2D (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd 'REPR-UNQUOT= E-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'quasiquote (list 'unquote (map wisp-replace-paren-quotation-= repr a)))) =2D (('REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'unquote (map wisp-replace-paren-quotation-repr a))) =2D ((a ... 'REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b) =2D (append =2D (map wisp-replace-paren-quotation-repr a) =2D (list (list 'unquote (map wisp-replace-paren-quotation-repr b))))) =2D (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'quasiquote (map wisp-replace-paren-quotation-repr a))) =2D ((a ... 'REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b); th= is is the quoted empty list =2D (append =2D (map wisp-replace-paren-quotation-repr a) =2D (list (list 'quasiquote (map wisp-replace-paren-quotation-repr b))= ))) =2D (('REPR-UNQUOTESPLICING-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'unquote-splicing (map wisp-replace-paren-quotation-repr a))) =2D (('REPR-SYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'syntax (map wisp-replace-paren-quotation-repr a))) =2D (('REPR-UNSYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'unsyntax (map wisp-replace-paren-quotation-repr a))) =2D (('REPR-QUASISYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'quasisyntax (map wisp-replace-paren-quotation-repr a))) =2D (('REPR-UNSYNTAXSPLICING-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) =2D (list 'unsyntax-splicing (map wisp-replace-paren-quotation-repr a))) =2D ;; literal array as start of a line: # (a b) c -> (#(a b) c) =2D ((#\# a ...) =2D (with-input-from-string ;; hack to defer to read =2D (string-append "#" =2D (with-output-to-string =2D (=CE=BB () =2D (write (map wisp-replace-paren-quotation-rep= r a) =2D (current-output-port))))) =2D read)) =2D ((a ...) =2D (map wisp-replace-paren-quotation-repr a)) =2D (a =2D a))) + (wisp-add-source-properties-from/when-required + code + (match code + (('REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'quote (map wisp-replace-paren-quotation-repr a))) + ((a ... 'REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b); this is = the quoted empty list + (append + (map wisp-replace-paren-quotation-repr a) + (list (list 'quote (map wisp-replace-paren-quotation-repr b))))) + (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd 'REPR-UNQUOTE= -e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'quasiquote (list 'unquote (map wisp-replace-paren-quotation-r= epr a)))) + (('REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'unquote (map wisp-replace-paren-quotation-repr a))) + ((a ... 'REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b) + (append + (map wisp-replace-paren-quotation-repr a) + (list (list 'unquote (map wisp-replace-paren-quotation-repr b))))) + (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'quasiquote (map wisp-replace-paren-quotation-repr a))) + ((a ... 'REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b); thi= s is the quoted empty list + (append + (map wisp-replace-paren-quotation-repr a) + (list (list 'quasiquote (map wisp-replace-paren-quotation-repr b)))= )) + (('REPR-UNQUOTESPLICING-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'unquote-splicing (map wisp-replace-paren-quotation-repr a))) + (('REPR-SYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'syntax (map wisp-replace-paren-quotation-repr a))) + (('REPR-UNSYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'unsyntax (map wisp-replace-paren-quotation-repr a))) + (('REPR-QUASISYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'quasisyntax (map wisp-replace-paren-quotation-repr a))) + (('REPR-UNSYNTAXSPLICING-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) + (list 'unsyntax-splicing (map wisp-replace-paren-quotation-repr a))) + ;; literal array as start of a line: # (a b) c -> (#(a b) c) + ((#\# a ...) + (with-input-from-string ;; hack to defer to read + (string-append "#" + (with-output-to-string + (=CE=BB () + (write (map wisp-replace-paren-quotation-repr= a) + (current-output-port))))) + read)) + ((a ...) + (map wisp-replace-paren-quotation-repr a)) + (a + a)))) =20 (define (wisp-make-improper code) "Turn (a #{.}# b) into the correct (a . b). @@ -660,18 +676,6 @@ when it reads a dot. So we have to take another pass o= ver the code to recreate the improper lists. =20 Match is awesome!" =2D (let =2D ((improper =2D (match code =2D ((a ... b 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd c) =2D (append (map wisp-make-improper a) =2D (cons (wisp-make-improper b) (wisp-make-improper c)))) =2D ((a ...) =2D (map wisp-make-improper a)) =2D (a =2D a)))) =2D (define (syntax-error li msg) =2D (raise-exception (make-exception-from-throw 'wisp-syntax-error (li= st (format #f "incorrect dot-syntax #{.}# in code: ~A: ~A" msg li))))) (if #t improper (let check @@ -706,7 +710,32 @@ Match is awesome!" (else a)))) (a =2D a)))))) + ;; local alias + (define (add-prop/req form) + (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)))) + (define (syntax-error li msg) + (raise-exception + (make-exception-from-throw + 'wisp-syntax-error + (list (format #f "incorrect dot-syntax #{.}# in code: ~A: ~A" msg= li))))) + a))))))) =20 (define (wisp-scheme-read-chunk port) "Read and parse one chunk of wisp-code" diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test index a888df41d..f4a19a0a7 100644 =2D-- a/test-suite/tests/srfi-119.test +++ b/test-suite/tests/srfi-119.test @@ -78,4 +78,12 @@ _ display \"hello\n\" (define (_) (display "hello\n")) =20 =2D(_))))) +(_)))) + + ;; nesting with pairs + (pass-if (equal? (wisp->list "1 . 2\n3 4\n 5 . 6") + '((1 . 2)(3 4 (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")))))) =2D-=20 2.41.0 From=207332c2c5bdc0a55a4c51fd8595b004ef768b675a Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Sun, 13 Aug 2023 11:39:19 +0200 Subject: [PATCH 10/11] SRFI-119 (wisp): improve indentation * module/language/wisp.scm (indentation): restructure so auto-format creates less indentation. =2D-- module/language/wisp.scm | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index 812a8bad0..506b37ea5 100644 =2D-- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -170,8 +170,8 @@ (define (line-strip-continuation line) (if (line-continues? line) (apply make-line =2D (line-indent line) =2D (cdr (line-code line))) + (line-indent line) + (cdr (line-code line))) line)) =20 (define (line-strip-indentation-marker line) @@ -462,9 +462,12 @@ (cons (cons 0 (cdr (car lines))) (cdr lines))) =2D (raise-exception (make-exception-from-throw 'wisp-syntax-error (= list =2D (format #f "The first symbol in a chunk must start at zer= o indentation. Indentation and line: ~A" =2D (car lines))))))) + (raise-exception + (make-exception-from-throw + 'wisp-syntax-error + (list + (format #f "The first symbol in a chunk must start at zero inde= ntation. Indentation and line: ~A" + (car lines))))))) (let loop ((processed '()) (unprocessed lines) @@ -496,7 +499,11 @@ ;; side-recursion (values processed unprocessed)) ((null? indentation-levels) =2D (raise-exception (make-exception-from-throw 'wisp-programming-er= ror (list "The indentation-levels are null but the current-line is null: S= omething killed the indentation-levels.")))) + (raise-exception + (make-exception-from-throw + 'wisp-programming-error + (list + "The indentation-levels are null but the current-line is null: = Something killed the indentation-levels.")))) (else ; now we come to the line-comparisons and indentation-countin= g. (cond ((line-empty-code? current-line) @@ -562,9 +569,12 @@ current-line-indentation indentation-levels))) (else =2D (raise-exception (make-exception-from-throw 'wisp-not-implemen= ted (list =2D (format #f "Need to implement further line comparison: = current: ~A, next: ~A, processed: ~A." =2D current-line next-line processed))))))))))) + (raise-exception + (make-exception-from-throw + 'wisp-not-implemented + (list + (format #f "Need to implement further line comparison: curren= t: ~A, next: ~A, processed: ~A." + current-line next-line processed))))))))))) =20 =20 (define (wisp-scheme-replace-inline-colons lines) =2D-=20 2.41.0 From=20fa76d6d2937da46e445f8cf2eaaa82c14fc5ec4f Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Sun, 13 Aug 2023 11:40:20 +0200 Subject: [PATCH 11/11] SRFI-119 (wisp): stricter syntax checks * module/language/wisp.scm (wisp-make-improper): run the syntax validation for illegal improper lists. =2D-- module/language/wisp.scm | 69 ++++++++++++++++++++-------------------- 1 file changed, 35 insertions(+), 34 deletions(-) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index 506b37ea5..b4e885eec 100644 =2D-- a/module/language/wisp.scm +++ b/module/language/wisp.scm @@ -686,40 +686,7 @@ when it reads a dot. So we have to take another pass o= ver the code to recreate the improper lists. =20 Match is awesome!" =2D (if #t =2D improper =2D (let check =2D ((tocheck improper)) =2D (match tocheck =2D ;; lists with only one member =2D (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) =2D (syntax-error tocheck "list with the period as only member"= )) =2D ;; list with remaining dot. =2D ((a ...) =2D (if (and (member repr-dot a)) =2D (syntax-error tocheck "leftover period in list") =2D (map check a))) =2D ;; simple pair - this and the next do not work when parsed f= rom wisp-scheme itself. Why? =2D (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd . c) =2D (syntax-error tocheck "dot as first element in already impr= oper pair")) =2D ;; simple pair, other way round =2D ((a . 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) =2D (syntax-error tocheck "dot as last element in already impro= per pair")) =2D ;; more complex pairs =2D ((? pair? a) =2D (let =2D ((head (drop-right a 1)) =2D (tail (last-pair a))) =2D (cond =2D ((equal? repr-dot (car tail)) =2D (syntax-error tocheck "equal? repr-dot : car tail")) =2D ((equal? repr-dot (cdr tail)) =2D (syntax-error tocheck "equal? repr-dot : cdr tail")) =2D ((member repr-dot head) =2D (syntax-error tocheck "member repr-dot head")) =2D (else =2D a)))) =2D (a + (define is-proper? #t) ;; local alias (define (add-prop/req form) (wisp-add-source-properties-from/when-required code form)) @@ -745,6 +712,40 @@ Match is awesome!" (make-exception-from-throw 'wisp-syntax-error (list (format #f "incorrect dot-syntax #{.}# in code: ~A: ~A" msg= li))))) + (if is-proper? + improper + (let check + ((tocheck improper)) + (match tocheck + ;; lists with only one member + (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) + (syntax-error tocheck "list with the period as only member")) + ;; list with remaining dot. + ((a ...) + (if (and (member repr-dot a)) + (syntax-error tocheck "leftover period in list") + (map check a))) + ;; simple pair - this and the next do not work when parsed fr= om wisp-scheme itself. Why? + (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd . c) + (syntax-error tocheck "dot as first element in already impro= per pair")) + ;; simple pair, other way round + ((a . 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) + (syntax-error tocheck "dot as last element in already improp= er pair")) + ;; more complex pairs + ((? 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")) + ((equal? repr-dot (cdr tail)) + (syntax-error tocheck "equal? repr-dot : cdr tail")) + ((member repr-dot head) + (syntax-error tocheck "member repr-dot head")) + (else + a)))) + (a a))))))) =20 (define (wisp-scheme-read-chunk port) =2D-=20 2.41.0 DIFF_WITHOUT_WHITESPACE 6 files changed, 214 insertions(+), 190 deletions(-) am/bootstrap.am | 3 + doc/ref/srfi-modules.texi | 11 +- module/language/wisp.scm | 329 ++++++++++++++++++++++----------------= --- module/language/wisp/spec.scm | 50 +++---- test-suite/Makefile.am | 1 + test-suite/tests/srfi-119.test | 10 +- modified am/bootstrap.am @@ -393,6 +393,9 @@ SOURCES =3D \ \ system/syntax.scm \ \ + language/wisp.scm \ + language/wisp/spec.scm \ + \ system/xref.scm \ \ sxml/apply-templates.scm \ modified doc/ref/srfi-modules.texi @@ -64,7 +64,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-98:: Accessing environment variables. * SRFI-105:: Curly-infix expressions. * SRFI-111:: Boxes. =2D* SRFI-119:: Wisp: simpler indentation-sensitive sche= me. +* SRFI-119:: Wisp: simpler indentation-sensitive Scheme. * SRFI-171:: Transducers @end menu =20 @@ -5664,13 +5664,14 @@ Set the contents of @var{box} to @var{value}. @end deffn =20 @node SRFI-119 =2D@subsection SRFI-119 Wisp: simpler indentation-sensitive scheme. +@subsection SRFI-119 Wisp: simpler indentation-sensitive Scheme. @cindex SRFI-119 @cindex wisp =20 =2DThe languages shipped in Guile include SRFI-119 (wisp), an encoding of =2DScheme that allows replacing parentheses with equivalent indentation and =2Dinline colons. See +The languages shipped in Guile include SRFI-119, also referred to as +@dfn{Wisp} (for ``Whitespace to Lisp''), an encoding of Scheme that +allows replacing parentheses with equivalent indentation and inline +colons. See @uref{http://srfi.schemers.org/srfi-119/srfi-119.html, the specification of SRFI-119}. Some examples: =20 modified module/language/wisp.scm @@ -33,19 +33,21 @@ (define-module (language wisp) #:export (wisp-scheme-read-chunk wisp-scheme-read-all wisp-scheme-read-file-chunk wisp-scheme= -read-file =2D wisp-scheme-read-string)) + wisp-scheme-read-string) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11); for let-values + #:use-module (srfi srfi-9); for records + #:use-module (ice-9 rw); for write-string/partial + #:use-module (ice-9 match)) =20 =2D; use curly-infix by default =2D(read-enable 'curly-infix) =2D =2D(use-modules =2D (srfi srfi-1) =2D (srfi srfi-11); for let-values =2D (ice-9 rw); for write-string/partial =2D (ice-9 match)) +;; use curly-infix by default +(eval-when (expand load eval) + (read-enable 'curly-infix)) =20 =20 ;; Helper functions for the indent-and-symbols data structure: '((indent t= oken token ...) ...) +(define make-line list) + (define (line-indent line) (car line)) =20 @@ -57,22 +59,23 @@ indent))) =20 (define (line-code line) + "Strip the indentation markers from the beginning of the line and preser= ve source-properties" (let ((code (cdr line))) =2D ; propagate source properties + ;; propagate source properties (when (not (null? code)) (set-source-properties! code (source-properties line))) code)) =20 =2D; literal values I need +;; literal values I need (define readcolon (string->symbol ":")) =20 (define wisp-uuid "e749c73d-c826-47e2-a798-c16c13cb89dd") =2D; define an intermediate dot replacement with UUID to avoid clashes. +;; define an intermediate dot replacement with UUID to avoid clashes. (define repr-dot ; . (string->symbol (string-append "REPR-DOT-" wisp-uuid))) =20 =2D; allow using reader additions as the first element on a line to prefix = the list +;; allow using reader additions as the first element on a line to prefix t= he list (define repr-quote ; ' (string->symbol (string-append "REPR-QUOTE-" wisp-uuid))) (define repr-unquote ; , @@ -91,8 +94,8 @@ (define repr-unsyntax-splicing ; #,@ (string->symbol (string-append "REPR-UNSYNTAXSPLICING-" wisp-uuid))) =20 =2D; TODO: wrap the reader to return the repr of the syntax reader =2D; additions +;; TODO: wrap the reader to return the repr of the syntax reader +;; additions =20 (define (match-charlist-to-repr charlist) (let @@ -160,20 +163,19 @@ =20 (define (line-empty? line) (and =2D ; if indent is -1, we stripped a comment, so the line was not= really empty. + ;; if indent is -1, we stripped a comment, so the line was not really e= mpty. (=3D 0 (line-indent line)) (line-empty-code? line))) =20 (define (line-strip-continuation line) (if (line-continues? line) =2D (append =2D (list =2D (line-indent line)) + (apply make-line + (line-indent line) (cdr (line-code line))) line)) =20 (define (line-strip-indentation-marker line) =2D "Strip the indentation markers from the beginning of the line" + "Strip the indentation markers from the beginning of the line for line-f= inalize without propagating source-properties (those are propagated in a se= cond step)" (cdr line)) =20 (define (indent-level-reduction indentation-levels level select-fun) @@ -189,7 +191,7 @@ (cdr newlevels) (1+ diff))) (else =2D (throw 'wisp-syntax-error "Level ~A not found in the inde= ntation-levels ~A."))))) + (raise-exception (make-exception-from-throw 'wisp-syntax-error (list= (format #f "Level ~A not found in the indentation-levels ~A." level indent= ation-levels)))))))) =20 (define (indent-level-difference indentation-levels level) "Find how many indentation levels need to be popped off to find the give= n level." @@ -210,74 +212,77 @@ (equal? repr-dot (list-ref currentsymbols (- (length currentsymbols) 1))))) =20 + (define (wisp-scheme-read-chunk-lines port) (let loop ((indent-and-symbols (list)); '((5 "(foobar)" "\"yobble\"")(3 "#t")) =2D (inindent #t) =2D (inunderscoreindent (equal? #\_ (peek-char port))) =2D (incomment #f) + (in-indent? #t) + (in-underscoreindent? (equal? #\_ (peek-char port))) + (in-comment? #f) (currentindent 0) (currentsymbols '()) (emptylines 0)) (cond =2D ((>=3D emptylines 2); the chunk end has to be checked =2D ; before we look for new chars in the =2D ; port to make execution in the REPL =2D ; after two empty lines work =2D ; (otherwise it shows one more line). + ((>=3D emptylines 2) + ;; the chunk end has to be checked + ;; before we look for new chars in the + ;; port to make execution in the REPL + ;; after two empty lines work + ;; (otherwise it shows one more line). indent-and-symbols) (else (let ((next-char (peek-char port))) (cond ((eof-object? next-char) =2D (append indent-and-symbols (list (append (list curren= tindent) currentsymbols)))) =2D ((and inindent (zero? currentindent) (not incomment) (n= ot (null? indent-and-symbols)) (not inunderscoreindent) (not (or (equal? #\= space next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) ne= xt-char)))) + (let ((line (apply make-line currentindent currentsymbols))) + (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 (nu= ll? indent-and-symbols)) (not in-underscoreindent?) (not (or (equal? #\spac= e next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) next-c= har)))) (append indent-and-symbols)); top-level form ends chunk ((chunk-ends-with-period currentsymbols next-char) =2D ; the line ends with a period. This is forbidden in =2D ; SRFI-119. Use it to end the line in the REPL without =2D ; showing continuation dots (...). =2D (append indent-and-symbols (list (append (list curren= tindent) (drop-right currentsymbols 1))))) =2D ((and inindent (equal? #\space next-char)) + ;; the line ends with a period. This is forbidden in + ;; SRFI-119. Use it to end the line in the REPL without + ;; showing continuation dots (...). + (append indent-and-symbols (list (apply make-line currentindent = (drop-right currentsymbols 1))))) + ((and in-indent? (equal? #\space next-char)) (read-char port); remove char (loop indent-and-symbols =2D #t ; inindent =2D #f ; inunderscoreindent =2D #f ; incomment + #t ; in-indent? + #f ; in-underscoreindent? + #f ; in-comment? (1+ currentindent) currentsymbols emptylines)) =2D ((and inunderscoreindent (equal? #\_ next-char)) + ((and in-underscoreindent? (equal? #\_ next-char)) (read-char port); remove char (loop indent-and-symbols =2D #t ; inindent =2D #t ; inunderscoreindent =2D #f ; incomment + #t ; in-indent? + #t ; in-underscoreindent? + #f ; in-comment? (1+ currentindent) currentsymbols emptylines)) =2D ; any char but whitespace *after* underscoreindent is =2D ; an error. This is stricter than the current wisp =2D ; syntax definition. TODO: Fix the definition. Better =2D ; start too strict. FIXME: breaks on lines with only =2D ; underscores which should be empty lines. =2D ((and inunderscoreindent (and (not (equal? #\space next= -char)) (not (equal? #\newline next-char)))) =2D (throw 'wisp-syntax-error "initial underscores withou= t following whitespace at beginning of the line after" (last indent-and-sym= bols))) + ;; 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. + ((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) (read-char port); remove the newline =2D ; The following two lines would break the REPL by req= uiring one char too many. =2D ; if : and (equal? #\newline next-char) : equal? #\re= turn : peek-char port =2D ; read-char port ; remove a full \n\r. Damn spec= ial cases... =2D (let* ; distinguish pure whitespace lines and lines =2D ; with comment by giving the former zero =2D ; indent. Lines with a comment at zero indent =2D ; get indent -1 for the same reason - meaning =2D ; not actually empty. + (let* + ;; distinguish pure whitespace lines and lines + ;; with comment by giving the former zero + ;; indent. Lines with a comment at zero indent + ;; get indent -1 for the same reason - meaning + ;; not actually empty. ((indent (cond =2D (incomment + (in-comment? (if (=3D 0 currentindent); specialcase -1 currentindent)) @@ -285,35 +290,35 @@ currentindent) (else 0))) =2D (parsedline (append (list indent) currentsymbols)) + (parsedline (apply make-line indent currentsymbols)) (emptylines (if (not (line-empty? parsedline)) 0 (1+ emptylines)))) =2D (when (not (=3D 0 (length parsedline))) =2D ; set the source properties to parsedline so we= can try to add them later. + (when (not (=3D 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 po= rt)) (set-source-property! parsedline 'line (port-line port))) =2D ; TODO: If the line is empty. Either do it here and= do not add it, just =2D ; increment the empty line counter, or strip it lat= er. Replace indent =2D ; -1 by indent 0 afterwards. + ;; TODO: If the line is empty. Either do it here and do not ad= d it, just + ;; increment the empty line counter, or strip it later. Replac= e indent + ;; -1 by indent 0 afterwards. (loop (append indent-and-symbols (list parsedline)) =2D #t ; inindent + #t ; in-indent? (if (<=3D 2 emptylines) #f ; chunk ends here (equal? #\_ (peek-char port))); are we in underscore inde= nt? =2D #f ; incomment + #f ; in-comment? 0 '() emptylines))) =2D ((equal? #t incomment) + ((equal? #t in-comment?) (read-char port); remove one comment character (loop indent-and-symbols =2D #f ; inindent=20 =2D #f ; inunderscoreindent=20 =2D #t ; incomment + #f ; in-indent? + #f ; in-underscoreindent? + #t ; in-comment? currentindent currentsymbols emptylines)) @@ -321,47 +326,47 @@ (read-char port); remove char (loop indent-and-symbols =2D #f ; inindent =2D #f ; inunderscoreindent =2D #f ; incomment + #f ; in-indent? + #f ; in-underscoreindent? + #f ; in-comment? currentindent currentsymbols emptylines)) =2D ; | cludge to appease the former wisp parser =2D ; | used for bootstrapping which has a =2D ; v problem with the literal comment char + ;; | cludge to appease the former wisp parser + ;; | used for bootstrapping which has a + ;; v problem with the literal comment char ((equal? (string-ref ";" 0) next-char) (loop indent-and-symbols =2D #f ; inindent =2D #f ; inunderscoreindent =2D #t ; incomment + #f ; in-indent? + #f ; in-underscoreindent? + #t ; in-comment? currentindent currentsymbols emptylines)) (else ; use the reader (loop indent-and-symbols =2D #f ; inindent =2D #f ; inunderscoreindent =2D #f ; incomment + #f ; in-indent? + #f ; in-underscoreindent? + #f ; in-comment? currentindent =2D ; this also takes care of the hashbang and leading = comments. + ;; this also takes care of the hashbang and leading comments. (append currentsymbols (list (wisp-read port))) emptylines)))))))) =20 =20 (define (line-code-replace-inline-colons line) "Replace inline colons by opening parens which close at the end of the l= ine" =2D ; format #t "replace inline colons for line ~A\n" line + ;; format #t "replace inline colons for line ~A\n" line (let loop ((processed '()) (unprocessed line)) (cond ((null? unprocessed) =2D ; format #t "inline-colons processed line: ~A\n" processed + ;; format #t "inline-colons processed line: ~A\n" processed processed) =2D ; replace : . with nothing + ;; replace : . with nothing ((and (<=3D 2 (length unprocessed)) (equal? readcolon (car unprocesse= d)) (equal? repr-dot (car (cdr unprocessed)))) (loop (append processed @@ -369,7 +374,6 @@ '())) ((equal? readcolon (car unprocessed)) (loop =2D ; FIXME: This should turn unprocessed into a list.=20 (append processed (list (loop '() (cdr unprocessed)))) '())) @@ -386,11 +390,8 @@ =20 (define (line-strip-lone-colon line) "A line consisting only of a colon is just a marked indentation level. W= e need to kill the colon before replacing inline colons." =2D (if =2D (equal? =2D (line-code line) =2D (list readcolon)) =2D (list (line-indent line)) + (if (equal? (line-code line) (list readcolon)) + (make-line (line-indent line)) line)) =20 (define (line-finalize line) @@ -416,6 +417,12 @@ #f)) target) =20 +(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 p= art of the code." (let loop @@ -432,12 +439,15 @@ processed) (else (let ((line (car unprocessed))) =2D (if (null? (source-properties unprocessed)) =2D (wisp-add-source-properties-from line unprocessed) =2D (wisp-add-source-properties-from unprocessed line)) =2D (loop =2D (append processed (list (wisp-propagate-source-properti= es line))) =2D (cdr unprocessed))))))) + (wisp-add-source-properties-from/when-required line unprocessed) + (wisp-add-source-properties-from/when-required code unprocessed) + (wisp-add-source-properties-from/when-required unprocessed line) + (wisp-add-source-properties-from/when-required unprocessed code) + (let ((processed (append processed (list (wisp-propagate-source-pr= operties line))))) + ;; must propagate from line, because unprocessed and code can be= null, then they cannot keep source-properties. + (wisp-add-source-properties-from/when-required line processed) + (loop processed + (cdr unprocessed)))))))) =20 (define* (wisp-scheme-indentation-to-parens lines) "Add parentheses to lines and remove the indentation markers" @@ -452,9 +462,12 @@ (cons (cons 0 (cdr (car lines))) (cdr lines))) =2D (throw 'wisp-syntax-error + (raise-exception + (make-exception-from-throw + 'wisp-syntax-error + (list (format #f "The first symbol in a chunk must start at zero inde= ntation. Indentation and line: ~A" =2D (car lines))))) + (car lines))))))) (let loop ((processed '()) (unprocessed lines) @@ -463,57 +476,53 @@ ((current-line (if (<=3D 1 (length unprocessed)) (car unprocessed) =2D (list 0))); empty code + (make-line 0))); empty code (next-line (if (<=3D 2 (length unprocessed)) (car (cdr unprocessed)) =2D (list 0))); empty code + (make-line 0))); empty code (current-indentation (car indentation-levels)) (current-line-indentation (line-real-indent current-line))) =2D ; format #t "processed: ~A\ncurrent-line: ~A\nnext-line: ~A= \nunprocessed: ~A\nindentation-levels: ~A\ncurrent-indentation: ~A\n\n" =2D ; . processed current-line next-line unprocessed indent= ation-levels current-indentation + ;; format #t "processed: ~A\ncurrent-line: ~A\nnext-line: ~A\nunproc= essed: ~A\nindentation-levels: ~A\ncurrent-indentation: ~A\n\n" + ;; . processed current-line next-line unprocessed indentation-le= vels current-indentation (cond =2D ; the real end: this is reported to the outside world. + ;; the real end: this is reported to the outside world. ((and (null? unprocessed) (not (null? indentation-levels)) (null? (= cdr indentation-levels))) =2D ; display "done\n" =2D ; reverse the processed lines, because I use cons. + ;; reverse the processed lines, because I use cons. processed) =2D ; the recursion end-condition + ;; the recursion end-condition ((and (null? unprocessed)) =2D ; display "last step\n" =2D ; this is the last step. Nothing more to do except =2D ; for rolling up the indentation levels. return the =2D ; new processed and unprocessed lists: this is a =2D ; side-recursion + ;; this is the last step. Nothing more to do except + ;; for rolling up the indentation levels. return the + ;; new processed and unprocessed lists: this is a + ;; side-recursion (values processed unprocessed)) ((null? indentation-levels) =2D ; display "indentation-levels null\n" =2D (throw 'wisp-programming-error "The indentation-levels = are null but the current-line is null: Something killed the indentation-lev= els.")) + (raise-exception + (make-exception-from-throw + 'wisp-programming-error + (list + "The indentation-levels are null but the current-line is null: = Something killed the indentation-levels.")))) (else ; now we come to the line-comparisons and indentation-countin= g. (cond ((line-empty-code? current-line) =2D ; display "current-line empty\n" =2D ; We cannot process indentation without =2D ; code. Just switch to the next line. This should =2D ; only happen at the start of the recursion. =2D ; TODO: Somehow preserve the line-numbers. + ;; We cannot process indentation without + ;; code. Just switch to the next line. This should + ;; only happen at the start of the recursion. (loop processed (cdr unprocessed) indentation-levels)) ((and (line-empty-code? next-line) (<=3D 2 (length unprocessed))) =2D ; display "next-line empty\n" =2D ; TODO: Somehow preserve the line-numbers. =2D ; take out the next-line from unprocessed. + ;; take out the next-line from unprocessed. (loop processed (cons current-line (cdr (cdr unprocessed))) indentation-levels)) ((> current-indentation current-line-indentation) =2D ; display "current-indent > next-line\n" =2D ; this just steps back one level via the side-rec= ursion. + ;; this just steps back one level via the side-recursion. (let ((previous-indentation (car (cdr indentation-levels)))) (if (<=3D current-line-indentation previous-indentation) (values processed unprocessed) @@ -527,14 +536,12 @@ current-line-indentation (cdr indentation-levels))))))) ((=3D current-indentation current-line-indentation) =2D ; display "current-indent =3D next-line\n" (let ((line (line-finalize current-line)) (next-line-indentation (line-real-indent next-line))) (cond ((>=3D current-line-indentation next-line-indentation) =2D ; simple recursiive step to the next line =2D ; display "current-line-indent >=3D next-li= ne-indent\n" + ;; simple recursiive step to the next line (loop (append processed (if (line-continues? current-line) @@ -543,22 +550,18 @@ (cdr unprocessed); recursion here indentation-levels)) ((< current-line-indentation next-line-indentation) =2D ; display "current-line-indent < next-line-= indent\n" =2D ; format #t "line: ~A\n" line =2D ; side-recursion via a sublist + ;; side-recursion via a sublist (let-values (((sub-processed sub-unprocessed) (loop line (cdr unprocessed); recursion here indentation-levels))) =2D ; format #t "side-recursion:\n sub-proce= ssed: ~A\n processed: ~A\n\n" sub-processed processed (loop (append processed (list sub-processed)) sub-unprocessed ; simply use the recursion from the sub-r= ecursion indentation-levels)))))) ((< current-indentation current-line-indentation) =2D ; display "current-indent < next-line\n" (loop processed unprocessed @@ -566,9 +569,12 @@ current-line-indentation indentation-levels))) (else =2D (throw 'wisp-not-implemented + (raise-exception + (make-exception-from-throw + 'wisp-not-implemented + (list (format #f "Need to implement further line comparison: curren= t: ~A, next: ~A, processed: ~A." =2D current-line next-line processed))))))))) + current-line next-line processed))))))))))) =20 =20 (define (wisp-scheme-replace-inline-colons lines) @@ -596,6 +602,8 @@ =20 (define (wisp-unescape-underscore-and-colon code) "replace \\_ and \\: by _ and :" + (wisp-add-source-properties-from/when-required + code (cond ((list? code) (map wisp-unescape-underscore-and-colon code)) ((eq? code '\:) ':) ;; Look for symbols like \____ and remove the \. @@ -606,21 +614,23 @@ (string-every #\_ (substring as-string 1))) (string->symbol (substring as-string 1)) code))) =2D (#t code))) + (#t code)))) =20 =20 (define (wisp-replace-empty-eof code) "replace ((#)) by ()" =2D ; FIXME: Actually this is a hack which fixes a bug when the =2D ; parser hits files with only hashbang and comments. + ;; This is a hack which fixes a bug when the + ;; parser hits files with only hashbang and comments. (if (and (not (null? code)) (pair? (car code)) (eof-object? (car (car co= de))) (null? (cdr code)) (null? (cdr (car code)))) =2D (list) + (wisp-add-source-properties-from code (list)) code)) =20 =20 (define (wisp-replace-paren-quotation-repr code) "Replace lists starting with a quotation symbol by quoted lists." + (wisp-add-source-properties-from/when-required + code (match code (('REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...) (list 'quote (map wisp-replace-paren-quotation-repr a))) @@ -664,7 +674,7 @@ ((a ...) (map wisp-replace-paren-quotation-repr a)) (a =2D a))) + a)))) =20 (define (wisp-make-improper code) "Turn (a #{.}# b) into the correct (a . b). @@ -676,38 +686,52 @@ when it reads a dot. So we have to take another pass = over the code to recreate the improper lists. =20 Match is awesome!" + (define is-proper? #t) + ;; local alias + (define (add-prop/req form) + (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) =2D (append (map wisp-make-improper a)=20 =2D (cons (wisp-make-improper b) (wisp-make-improper 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 ...) =2D (map wisp-make-improper a)) + (add-prop/req + (map wisp-make-improper (map add-prop/req a)))) (a a)))) (define (syntax-error li msg) =2D (throw 'wisp-syntax-error (format #f "incorrect dot-s= yntax #{.}# in code: ~A: ~A" msg li))) =2D (if #t + (raise-exception + (make-exception-from-throw + 'wisp-syntax-error + (list (format #f "incorrect dot-syntax #{.}# in code: ~A: ~A" msg= li))))) + (if is-proper? improper (let check ((tocheck improper)) (match tocheck =2D ; lists with only one member + ;; lists with only one member (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) (syntax-error tocheck "list with the period as only member")) =2D ; list with remaining dot. + ;; list with remaining dot. ((a ...) (if (and (member repr-dot a)) (syntax-error tocheck "leftover period in list") (map check a))) =2D ; simple pair - this and the next do not work when parsed= from wisp-scheme itself. Why? + ;; simple pair - this and the next do not work when parsed fr= om wisp-scheme itself. Why? (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd . c) (syntax-error tocheck "dot as first element in already impro= per pair")) =2D ; simple pair, other way round + ;; simple pair, other way round ((a . 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd) (syntax-error tocheck "dot as last element in already improp= er pair")) =2D ; more complex pairs + ;; more complex pairs ((? pair? a) (let ((head (drop-right a 1)) @@ -722,7 +746,7 @@ Match is awesome!" (else a)))) (a =2D a)))))) + a))))))) =20 (define (wisp-scheme-read-chunk port) "Read and parse one chunk of wisp-code" @@ -758,4 +782,3 @@ Match is awesome!" =20 (define (wisp-scheme-read-string-chunk str) (call-with-input-string str wisp-scheme-read-chunk)) =2D modified module/language/wisp/spec.scm @@ -1,32 +1,25 @@ =2D;; Language interface for Wisp in Guile +;;; Language interface for Wisp in Guile =20 =2D;;; adapted from guile-sweet: https://gitorious.org/nacre/guile-sweet/so= urce/ae306867e371cb4b56e00bb60a50d9a0b8353109:sweet/common.scm +;; Copyright (C) 2005--2014 by David A. Wheeler and Alan Manuel K. Gloria +;; Copyright (C) 2014--2023 Arne Babenhauserheide. +;; Copyright (C) 2023 Maxime Devos =20 =2D;;; Copyright (C) 2005--2014 by David A. Wheeler and Alan Manuel K. Glor= ia =2D;;; Copyright (C) 2014--2023 Arne Babenhauserheide. =2D;;; Copyright (C) 2023 Maxime Devos +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1= 301 USA =20 =2D;;; Permission is hereby granted, free of charge, to any person =2D;;; obtaining a copy of this software and associated documentation =2D;;; files (the "Software"), to deal in the Software without =2D;;; restriction, including without limitation the rights to use, copy, =2D;;; modify, merge, publish, distribute, sublicense, and/or sell copies =2D;;; of the Software, and to permit persons to whom the Software is =2D;;; furnished to do so, subject to the following conditions: =2D;;; =2D;;; The above copyright notice and this permission notice shall be =2D;;; included in all copies or substantial portions of the Software. =2D;;; =2D;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, =2D;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF =2D;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND =2D;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS =2D;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN =2D;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN =2D;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE =2D;;; SOFTWARE. +;; adapted from spec.scm: https://gitorious.org/nacre/guile-sweet/?p=3Dnac= re:guile-sweet.git;a=3Dblob;f=3Dsweet/spec.scm;hb=3Dae306867e371cb4b56e00bb= 60a50d9a0b8353109 =20 =2D; adapted from spec.scm: https://gitorious.org/nacre/guile-sweet/source/= ae306867e371cb4b56e00bb60a50d9a0b8353109:sweet/spec.scm (define-module (language wisp spec) #:use-module (language wisp) #:use-module (system base compile) @@ -58,7 +51,7 @@ (car chunk)))))) =20 (define-language wisp =2D #:title "Wisp Scheme Syntax. See SRFI-119 for details." + #:title "Wisp Scheme Syntax. See SRFI-119 for details" ; . #:reader read-one-wisp-sexp #:reader read-one-wisp-sexp ; : lambda (port env) : let ((x (read-one-wi= sp-sexp port env))) (display x)(newline) x ; #:compilers `((tree-il . ,compile-tree-il)) @@ -74,11 +67,6 @@ ;; compile-time changes to `current-reader' are ;; limited to the current compilation unit. (module-define! m 'current-reader (make-fluid)) =2D ;; Default to `simple-format', as is the case until =2D ;; (ice-9 format) is loaded. This allows =2D ;; compile-time warnings to be emitted when using =2D ;; unsupported options. =2D (module-set! m 'format simple-format) m))) =20 =20 modified test-suite/Makefile.am @@ -162,6 +162,7 @@ SCM_TESTS =3D tests/00-initial-env.test \ tests/srfi-98.test \ tests/srfi-105.test \ tests/srfi-111.test \ + tests/srfi-119.test \ tests/srfi-171.test \ tests/srfi-4.test \ tests/srfi-9.test \ modified test-suite/tests/srfi-119.test @@ -78,4 +78,12 @@ _ display \"hello\n\" (define (_) (display "hello\n")) =20 =2D(_))))) +(_)))) + + ;; nesting with pairs + (pass-if (equal? (wisp->list "1 . 2\n3 4\n 5 . 6") + '((1 . 2)(3 4 (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")))))) =2D-=20 Unpolitisch sein hei=C3=9Ft politisch sein, ohne es zu merken. draketo.de --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCAAuFiEE801qEjXQSQPNItXAE++NRSQDw+sFAmTakO4QHGFybmVfYmFi QHdlYi5kZQAKCRAT741FJAPD61E/D/0fZVXy9XlGekaWhMT8/XoUTLEkkjtfCcSp B3e/x33fs73jZBK87Ig42Z/LS1SGJ9U/ahyEV8aawkbA7jwxkKB8f5CiWSkySw+B jXppJSq9k7gk528V0Emd16BNXbXc4v2/stzbyfH0IJwwL8Zfp2Xb3zivKBGfbh54 XqeAcnmNOg9t6CJyvWkoez4UR0MHsZWhOJXmxh/1jF/yvA1I8iSPXO5wg0NyO9SY XcUaSYEVv5qAunLMyZTLKcUybh3jmWp1oFy0oVmN0Y4JBbvQe7FVqYvAY3+YxO4B SFsyK4XovJV4jQDTwppnjjIHsrgt18Jh4B09VYyTlCVLVOI/TvQAo17tWEUbyQeg SJ/aQU3ea00uGlN7KOOvcTKsL23wNmVIzcyauN9UljJ0LV/fkcEJ2+I38/bpvzIs 4Kfj4ev/Ud3yxHdy6Q3XM4vTWhphMcwwVrUhrVQEB7t5n6AJnCvxCZSqRMk7LKNb o9cG58UMIs7tEv2Bk1O7dHqOwPozAhKvvrJ2YXww5AkLUxPlO1EEj2ojUniAYhq6 4PmFYNqSjhJQNkE+a59XR3w/8f+Hn/rbAwXnZZKbPM1iO8HU6TBtlFyA3GTSLJ+P ljjlARpSusJyOI/SVnCfpIGBy+NGU1F06UV2Aq8fSU7Y2damnnrzWwPqgCJOIjcQ 4BUi79c0JIjEBAEBCAAuFiEE3Si95tmHXKvOSosd3M8NswvBBUgFAmTakO4QHGFy bmVfYmFiQHdlYi5kZQAKCRDczw2zC8EFSA6nA/420ViQ6Q6kKfyFi6pcKiO9+jCt jhXjegTnreX0m5kaEgao/rVc24OjGG/LqtDUDB1b9B5TOqRL8JyTL8SFhZqa540l HzkkZclwapCyMniGevnTatxrIlLpV7V2Pj7Xch3n9zLYrvUAt8ikwkEarvqEDIDy vBTHn03diiGXxqxoCw== =VQvo -----END PGP SIGNATURE----- --=-=-=--