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:11:55 +0200 Message-ID: <875y5h8j04.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> 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="15956"; 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:30:40 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 1qVeD2-0003vc-DF for guile-devel@m.gmane-mx.org; Mon, 14 Aug 2023 22:30:40 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qVeCi-0005cQ-Pd; Mon, 14 Aug 2023 16:30:20 -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 1qVeCh-0005cH-Bc for guile-devel@gnu.org; Mon, 14 Aug 2023 16:30:19 -0400 Original-Received: from mout.web.de ([212.227.17.11]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qVeCZ-0003PV-5K; Mon, 14 Aug 2023 16:30:19 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=web.de; s=s29768273; t=1692045005; x=1692649805; i=arne_bab@web.de; bh=BE3deveCnUotBQymHmJn2LM90x4N6C/O2hbj6EioTqM=; h=X-UI-Sender-Class:References:From:To:Cc:Subject:Date:In-reply-to; b=j0hlvF/+91ZUnvals1k+5KZKbDlL9o0Dt0D0uO+ox6xjldxeAS5lUmyPQi704riNOug7oLq xi+EjopCftVizpXy8leoYHSMyuvHc2mcwTy7t93OOv714b6t2V/y51GQQa4xOFDiQnGd57tcg 4fv1Kqu9L4RB58R38EKeiK8MRyigaW/BChygxrNMr7Mg/IycPytXlFk3zWe4E6n1hy6GPlP6F iT3joS1V8FpibTsqrq6+sRKSzRTNtZ+hwoatFl4Y1ZtHCvP8QrOOnVLMut4VRqHp4UtbN6Mrg 5sc59nJHHzw1PJ0abp0/dHpzjsfWMf8OLjV5fHTHgvMCtcnjNbAg== 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 1M2ggX-1qUG5T2swx-004E4R; Mon, 14 Aug 2023 22:30:04 +0200 In-reply-to: <87o7jf2slw.fsf@web.de> X-Provags-ID: V03:K1:JaHkIOzeVeImF8li9J6FjNlL0tffHxWkIuiJLy29BFeN6jctpVz YQJucrT0xq3fP+w7tCxUHby4OTkGirPww1r13vSl/754S7qJspFNWUYFbxu0LpgzZTTqGcP cCtj2dqKdfT6Jius+bB0IL/bK5V/cEyGk+253rt5Nd27X7rxZ/Ew0ZzN6AgA1d+oC5tJ3D5 mP2XU2zqVEHpbQlS1cvYQ== UI-OutboundReport: notjunk:1;M01:P0:VYb+vC90P1M=;FotNOa09wnzZ1bVV4YvAq+CtkYq CtCXQmK3jG0fCnYij7LRYGc5m6wNSmfqhHMV3H/9UnapyYfrGmEGGhyxcXAIW0bzzIHjt0HhF 986Pa/zdjnMDVexbPVJuA0aTXQucNZQzoIXUpxqS7X2viJn7Q1arrn+XVsxBCKvsjgehQDoFn O5l09aVw65gOQrk8MrIgl4GPispL4z4WYmuhIf/WGKs7IidzWA9iCc+rbJ0gMhIJSAF7Ek/1M yJ05j5gR0BUQ4bZcL4inGhihm99Ih4yXw2JJCDOQJ2tkSyqOixv7kyvSjf/A16hYd2CbQOkuc 55a7kYM98PByBqor7g8W4I75WtKSckbeLv1TE3pnrWApC84qvpAsBVZ582d8VUlS+08h0tyt8 qvObMJ5GJi+7DfraSNKaRrThEofUgtZoIQ7qQqsVuUAcarFP7KgDJFRtXOjvmrFhtp9U3axMZ 30G9zjN6B/oASgyeMhBzvma9Y+wh6ADheAPYRhoYuJSuQLeOZPlTXoQW3i52jo9o+/PjRzNUu 5uW5Fpj1fnXN9Tbus8kE37LU5DnwFXsxO68AWi8Ha1NLn1GzqzZoUBpbusMvk0tImamt2xri2 9kpJFG+9155+8ayDvu1MdGHR5RWvf/mRjRoeesm7jBXpOK02mau6LZt3E5AsnFPWhlHSZX4Ia I/bli+Ucnz7dbapNqZOayGYVsa7ODymazp7yhV29O87QugTcfVm23AANIDo9mW1rMLlFMm9gn L4U2CXfbOnTSP3q0T97QoulPXv7Utl8OWqN0T2+fyfnwiITA9TtMSKuY3PLVP7K09gEUmNW3 Received-SPF: pass client-ip=212.227.17.11; envelope-from=arne_bab@web.de; helo=mout.web.de X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 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_MSPIKE_H3=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:21910 Archived-At: --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi, I did the changes for the review. It took a while (sorry for that) but it got cleaner as a result (thank you!) Firstoff: I=E2=80=99d like to assign my copyright to the FSF. I=E2=80=99ll = sign the papers once I receive them. Also I have an Employer disclaimer of rights on paper for Emacs already, so that should not cause trouble. Attached is a new squashed patch. I=E2=80=99ll send another email with only= the commits for the individual changes on top of the original squashed patch to avoid tripping up tools that extract diffs. Changes: =2D [X] LGPL =2D [X] Please add the new files to the relevant =E2=80=98Makefile.am=E2=80= =99 files. =2D [X] Note the changes in Makefiles in the commit =2D [X] Please capitalize =E2=80=9CScheme=E2=80=9D and =E2=80=9CWisp=E2=80= =9D (in general we like to pay attention to typography, spelling, and langu= age in the manual.) =2D [X] s/(wisp)/, also referred to as @dfn{Wisp} (for ``Whitespace =E2=80= =A6'')/ =2D [X] Two spaces after end-of-sentence periods, to facilitate navigation = in Emacs. =2D [X] indent =E2=80=9Cthe usual way=E2=80=9D =2D [X] comments always with ;; except for margin comments =2D [X] (read-enable 'curly-infix) This needs to be: (eval-when (expand load eval) (read-enable 'curly-infix)) =2D [X] Please make them #:use-module clauses in the =E2=80=98define-module= =E2=80=99 form =2D [X] I=E2=80=99d encourage following the usual naming convention, so =E2=80=98in-indent?=E2=80=99, =E2=80=98in-comment?=E2=80=99, etc. =2D [X] use exception objects or SRFI-35 error conditions instead of throw = with symbols =2D [X] add a test for source location info A change I did not do: =2D [ ] +Use record-types for the lines+. Reason: I decided not to do this because it currently needs to propagate the source properties when retrieving the code, so this is not a good match for a record type (it may become one with an annotated reader, but I=E2=80=99d like to shift that to a later change: > implementing the =E2=80=9Cannotated read=E2=80=9D interface (info "(guile) > Annotated Scheme Read"). That can come in a subsequent patch, though. Ludovic Court=C3=A8s writes: > Overall I=E2=80=99m confident the code has been battle-tested (I suppose = there > are minimal changes compared to Wisp, right?), so I=E2=80=99ll comment mo= stly on > cosmetic issues. Yes, the code comes directly from Wisp. The original was simply auto-translated. Naturally that=E2=80=99s no guarantee that there are no bu= gs, but there should be few enough that this can be used in production. >> From c7a50f632293cf88f241d45d1fd52fa2f58ce772 Mon Sep 17 00:00:00 2001 >> From: Arne Babenhauserheide >> Date: Fri, 3 Feb 2023 22:20:04 +0100 >> Subject: [PATCH] Add language/wisp, wisp tests, and srfi-119 documentati= on >> >> * doc/ref/srfi-modules.texi (srfi-119): add node >> * module/language/wisp.scm: New file. >> * module/language/wisp/spec.scm: New file. >> * test-suite/tests/srfi-119.test: New file. > > Please add the new files to the relevant =E2=80=98Makefile.am=E2=80=99 fi= les. Added. >> +* SRFI-119:: Wisp: simpler indentation-sensitive sch= eme. > > Please capitalize =E2=80=9CScheme=E2=80=9D (in general we like to pay att= ention to > typography, spelling, and language in the manual.) > >> +The languages shipped in Guile include SRFI-119 (wisp), an encoding of > > s/(wisp)/, also referred to as @dfn{Wisp} (for ``Whitespace =E2=80=A6'')/ > >> +Scheme that allows replacing parentheses with equivalent indentation and >> +inline colons. See > > Two spaces after end-of-sentence periods, to facilitate navigation in > Emacs. Adjusted. >> +(define-module (language wisp) >> + #:export (wisp-scheme-read-chunk wisp-scheme-read-all=20 >> + wisp-scheme-read-file-chunk wisp-scheme-read-file >> + wisp-scheme-read-string)) > > Please remove tabs from this file and indent it =E2=80=9Cthe usual way=E2= =80=9D. You > can do that by passing it through Emacs and using =E2=80=98M-x indent-reg= ion=E2=80=99, > or possibly using =E2=80=98guix style -f=E2=80=99. I used M-x indent-region. > Use two leading colons for comments, except for margin comments. =F0=9F=91=8D >> +(read-enable 'curly-infix) > > This needs to be: > > (eval-when (expand load eval) > (read-enable 'curly-infix)) Adjusted =E2=80=94 thank you (when to use eval-when was always a bit of a mystery to me =E2=80=A6). > Please make them #:use-module clauses in the =E2=80=98define-module=E2=80= =99 form above. Done. > Instead of using lists or pairs for =E2=80=9Clines=E2=80=9D, I suggest de= fining a proper > record type, like: > =E2=80=A6 > This will make the code easier to read and type-clear. Instead of this, I created a make-line procedure to make this easy to refactor later when the code no longer needs adaptions when retrieving the code part. > I=E2=80=99d encourage following the usual naming convention, so =E2=80=98= in-indent?=E2=80=99, > =E2=80=98in-comment?=E2=80=99, etc. Done. >> + ((and inunderscoreindent (and (not (equal? #\space next-char)) >> (not (equal? #\newline next-char)))) >> + (throw 'wisp-syntax-error "initial underscores without following >> whitespace at beginning of the line after" (last >> indent-and-symbols))) > > I suggest using exception objects or SRFI-35 error conditions (they=E2=80= =99re > interchangeable) carrying information about the king of parsing error > and its location. That way, the user interface, such as the compiler, > can produce helpful error messages (and internationalized, too). Done: I used the convenience transformation, i.e. (raise-exception (make-exception-from-throw 'wisp-syntax-error (list (format #f "Level ~A not found in the indentation-levels ~A." level indentation-levels)))) >> +++ b/module/language/wisp/spec.scm > Can you make it LGPLv3+? It=E2=80=99s a small file anyway. I investigated and found that it actually was LGPLv3+ in the beginning and I got permission to relicense to MIT for the SRFI, so with permission of Maxime (who did later changes) this is now LGPLv3+ again. >> + (let ((m (make-fresh-user-module))) >> + ;; Provide a separate `current-reader' fluid so that >> + ;; compile-time changes to `current-reader' are >> + ;; limited to the current compilation unit. >> + (module-define! m 'current-reader (make-fluid)) >> + ;; Default to `simple-format', as is the case until >> + ;; (ice-9 format) is loaded. This allows >> + ;; compile-time warnings to be emitted when using >> + ;; unsupported options. >> + (module-set! m 'format simple-format) > > I=E2=80=99d remove this last statement, I think we should avoid fiddling = with > bindings here. Removed it now. >> +(define-module (test-srfi-119) >> + #:use-module (test-suite lib) >> + #:use-module (srfi srfi-1) >> + #:use-module (language wisp)) > > The test suite looks rather short; it would be nice if it would cover > more code. I have a pretty extensive test-suite in wisp itself but I didn=E2=80=99t th= ink it proper to just paste it into Guile. If you=E2=80=99d prefer that, I can = still add it all, though. > In particular, I think source location info is important for front-ends > like this, because it determines the quality of error messages and thus > its ease of use. Perhaps you could add test in that direction? I added a test and found shortcomings thanks to it. After fixing these, the current code has more robust source-property handling (that hadn=E2=80= =99t yet been tested further than ensuring that error messages give proper source positions =E2=80=94 which they did). > Overall I feel we should be able to merge this rather soon. Do ping me > or Andy when needed! Thank you! The following is the complete squashed patch. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-Add-language-wisp-wisp-tests-and-srfi-119-documentat.patch Content-Transfer-Encoding: quoted-printable Content-Description: squashed patch From=205857f8b961562d1ad2ae201401d5343233422eff Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide Date: Fri, 3 Feb 2023 22:20:04 +0100 Subject: [PATCH] Add language/wisp, wisp tests, and srfi-119 documentation * doc/ref/srfi-modules.texi (srfi-119): add node * module/language/wisp.scm: New file. * module/language/wisp/spec.scm: New file. * test-suite/tests/srfi-119.test: New file. * 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 + doc/ref/srfi-modules.texi | 31 ++ module/language/wisp.scm | 784 +++++++++++++++++++++++++++++++++ module/language/wisp/spec.scm | 73 +++ test-suite/Makefile.am | 3 +- test-suite/tests/srfi-119.test | 89 ++++ 6 files changed, 982 insertions(+), 1 deletion(-) create mode 100644 module/language/wisp.scm create mode 100644 module/language/wisp/spec.scm create mode 100644 test-suite/tests/srfi-119.test 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/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 0cdf56923..5b82f8070 100644 =2D-- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -64,6 +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. +* SRFI-119:: Wisp: simpler indentation-sensitive Scheme. * SRFI-171:: Transducers @end menu =20 @@ -5662,6 +5663,35 @@ Return the current contents of @var{box}. Set the contents of @var{box} to @var{value}. @end deffn =20 +@node SRFI-119 +@subsection SRFI-119 Wisp: simpler indentation-sensitive Scheme. +@cindex SRFI-119 +@cindex wisp + +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: + +@example +display "Hello World!" @result{} (display "Hello World!") +@end example + +@example +define : factorial n @result{} (define (factorial n) + if : zero? n @result{} (if (zero? n) + . 1 @result{} 1 + * n : factorial @{n - 1@} @result{} (* n (factorial @{n - 1@})))) +@end example + +To execute a file with wisp code, select the language and filename +extension @code{.w} vie @code{guile --language=3Dwisp -x .w}. + +In files using Wisp, @xref{SRFI-105} (Curly Infix) is always activated. + + @node SRFI-171 @subsection Transducers @cindex SRFI-171 @@ -5705,6 +5735,7 @@ left-to-right, due to how transducers are initiated. * SRFI-171 Helpers:: Utilities for writing your own trans= ducers @end menu =20 + @node SRFI-171 General Discussion @subsubsection SRFI-171 General Discussion @cindex transducers discussion diff --git a/module/language/wisp.scm b/module/language/wisp.scm new file mode 100644 index 000000000..b4e885eec =2D-- /dev/null +++ b/module/language/wisp.scm @@ -0,0 +1,784 @@ +;;; Wisp + +;; Copyright (C) 2013, 2017, 2018, 2020 Free Software Foundation, Inc. +;; Copyright (C) 2014--2023 Arne Babenhauserheide. +;; 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 + +;;; Commentary: + +;; Scheme-only implementation of a wisp-preprocessor which output a +;; scheme code tree to feed to a scheme interpreter instead of a +;; preprocessed file. + +;; Limitations: +;; - in some cases the source line information is missing in backtraces. +;; check for set-source-property! + +;;; Code: + +(define-module (language wisp) + #: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)) + +;; use curly-infix by default +(eval-when (expand load eval) + (read-enable 'curly-infix)) + + +;; Helper functions for the indent-and-symbols data structure: '((indent t= oken token ...) ...) +(define make-line list) + +(define (line-indent line) + (car line)) + +(define (line-real-indent line) + "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))) + +(define (line-code line) + "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)) + +;; literal values I need +(define readcolon + (string->symbol ":")) + +(define wisp-uuid "e749c73d-c826-47e2-a798-c16c13cb89dd") +;; define an intermediate dot replacement with UUID to avoid clashes. +(define repr-dot ; . + (string->symbol (string-append "REPR-DOT-" wisp-uuid))) + +;; 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 ; , + (string->symbol (string-append "REPR-UNQUOTE-" wisp-uuid))) +(define repr-quasiquote ; ` + (string->symbol (string-append "REPR-QUASIQUOTE-" wisp-uuid))) +(define repr-unquote-splicing ; ,@ + (string->symbol (string-append "REPR-UNQUOTESPLICING-" wisp-uuid))) + +(define repr-syntax ; #' + (string->symbol (string-append "REPR-SYNTAX-" wisp-uuid))) +(define repr-unsyntax ; #, + (string->symbol (string-append "REPR-UNSYNTAX-" wisp-uuid))) +(define repr-quasisyntax ; #` + (string->symbol (string-append "REPR-QUASISYNTAX-" wisp-uuid))) +(define repr-unsyntax-splicing ; #,@ + (string->symbol (string-append "REPR-UNSYNTAXSPLICING-" wisp-uuid))) + +;; TODO: wrap the reader to return the repr of the syntax reader +;; additions + +(define (match-charlist-to-repr charlist) + (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)))) + +(define (wisp-read port) + "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)))))))) + + + +(define (line-continues? line) + (equal? repr-dot (car (line-code line)))) + +(define (line-only-colon? line) + (and + (equal? ":" (car (line-code line))) + (null? (cdr (line-code line))))) + +(define (line-empty-code? line) + (null? (line-code line))) + +(define (line-empty? 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))) + +(define (line-strip-continuation line) + (if (line-continues? line) + (apply make-line + (line-indent line) + (cdr (line-code line))) + line)) + +(define (line-strip-indentation-marker 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)) + +(define (indent-level-reduction indentation-levels level select-fun) + "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)))))))) + +(define (indent-level-difference indentation-levels level) + "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)))) + +(define (indent-reduce-to-level indentation-levels level) + "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))))) + +(define (chunk-ends-with-period currentsymbols next-char) + "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))))) + + +(define (wisp-scheme-read-chunk-lines port) + (let loop + ((indent-and-symbols (list)); '((5 "(foobar)" "\"yobble\"")(3 "#t")) + (in-indent? #t) + (in-underscoreindent? (equal? #\_ (peek-char port))) + (in-comment? #f) + (currentindent 0) + (currentsymbols '()) + (emptylines 0)) + (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) + (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) + ;; 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)))))))) + + +(define (line-code-replace-inline-colons line) + "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)))))) + +(define (line-replace-inline-colons line) + (cons + (line-indent line) + (line-code-replace-inline-colons (line-code line)))) + +(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." + (if (equal? (line-code line) (list readcolon)) + (make-line (line-indent line)) + line)) + +(define (line-finalize line) + "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)) + +(define (wisp-add-source-properties-from source 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) + +(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 + ((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))) + (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)))))))) + +(define* (wisp-scheme-indentation-to-parens lines) + "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 + (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) + (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-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) + ;; 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-implemented + (list + (format #f "Need to implement further line comparison: curren= t: ~A, next: ~A, processed: ~A." + current-line next-line processed))))))))))) + + +(define (wisp-scheme-replace-inline-colons lines) + "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))))) + + +(define (wisp-scheme-strip-indentation-markers lines) + "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))))) + +(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 \. + ((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)))) + + +(define (wisp-replace-empty-eof 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)))) + (wisp-add-source-properties-from code (list)) + code)) + + +(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))) + ((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)))) + +(define (wisp-make-improper code) + "Turn (a #{.}# b) into the correct (a . b). + +read called on a single dot creates a variable named #{.}# (|.| +in r7rs). Due to parsing the indentation before the list +structure is known, the reader cannot create improper lists +when it reads a dot. So we have to take another pass over the +code to recreate the improper lists. + +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) + (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))))) + (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))))))) + +(define (wisp-scheme-read-chunk port) + "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))))))))) + +(define (wisp-scheme-read-all 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))))))) + +(define (wisp-scheme-read-file path) + (call-with-input-file path wisp-scheme-read-all)) + +(define (wisp-scheme-read-file-chunk path) + (call-with-input-file path wisp-scheme-read-chunk)) + +(define (wisp-scheme-read-string str) + (call-with-input-string str wisp-scheme-read-all)) + +(define (wisp-scheme-read-string-chunk str) + (call-with-input-string str wisp-scheme-read-chunk)) diff --git a/module/language/wisp/spec.scm b/module/language/wisp/spec.scm new file mode 100644 index 000000000..1efd3e8b2 =2D-- /dev/null +++ b/module/language/wisp/spec.scm @@ -0,0 +1,73 @@ +;;; Language interface for Wisp in Guile + +;; Copyright (C) 2005--2014 by David A. Wheeler and Alan Manuel K. Gloria +;; Copyright (C) 2014--2023 Arne Babenhauserheide. +;; 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 + +;; 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 + +(define-module (language wisp spec) + #:use-module (language wisp) + #:use-module (system base compile) + #:use-module (system base language) + #:use-module (language scheme compile-tree-il) + #:use-module (language scheme decompile-tree-il) + #:export (wisp)) + +;;; +;;; Language definition +;;; + + +(define (read-one-wisp-sexp port env) + ;; Allow using "# foo" as #(foo). + ;; Don't use the globally-acting read-hash-extend, because this + ;; doesn't make much sense in parenthese-y (non-Wisp) Scheme. + ;; Instead, use fluids to temporarily add the extension. + (with-fluids ((%read-hash-procedures (fluid-ref %read-hash-procedures))) + (read-hash-extend #\# (lambda args #\# )) + ;; Read Wisp files as UTF-8, to support non-ASCII characters. + ;; TODO: would be nice to support ';; coding: whatever' lines + ;; like in parenthese-y Scheme. + (set-port-encoding! port "UTF-8") + (if (eof-object? (peek-char port)) + (read-char port) ; return eof: we=E2=80=99re done + (let ((chunk (wisp-scheme-read-chunk port))) + (and (not (null? chunk)) ; <---- XXX: maybe (pair? chunk) + (car chunk)))))) + +(define-language wisp + #: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)) + #:decompilers `((tree-il . ,decompile-tree-il)) + #:evaluator (lambda (x module) (primitive-eval x)) + #:printer write ; TODO: backtransform to wisp? Use source-properties? + #:make-default-environment + (lambda () + ;; Ideally we'd duplicate the whole module hierarchy so that `set!', + ;; `fluid-set!', etc. don't have any effect in the current environment. + (let ((m (make-fresh-user-module))) + ;; Provide a separate `current-reader' fluid so that + ;; compile-time changes to `current-reader' are + ;; limited to the current compilation unit. + (module-define! m 'current-reader (make-fluid)) + m))) + + + 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 \ diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test new file mode 100644 index 000000000..f4a19a0a7 =2D-- /dev/null +++ b/test-suite/tests/srfi-119.test @@ -0,0 +1,89 @@ +;;;; srfi-119.test --- Test suite for Guile's SRFI-119 reader. -*- scheme = -*- +;;;; +;;;; Copyright (C) 2023 Free Software Foundation, Inc. +;;;; +;;;; 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 + +(define-module (test-srfi-119) + #:use-module (test-suite lib) + #:use-module (srfi srfi-1) + #:use-module (language wisp)) + +(define (read-string s) + (with-input-from-string s read)) + +(define (with-read-options opts thunk) + (let ((saved-options (read-options))) + (dynamic-wind + (lambda () + (read-options opts)) + thunk + (lambda () + (read-options saved-options))))) + +(define (wisp->list str) + (wisp-scheme-read-string str)) + +(with-test-prefix "wisp-read-simple" + (pass-if (equal? (wisp->list "<=3D n 5") '((<=3D n 5)))) + (pass-if (equal? (wisp->list ". 5") '(5))) + (pass-if (equal? (wisp->list "+ 1 : * 2 3") '((+ 1 (* 2 3)))))) +(with-test-prefix "wisp-read-complex" + (pass-if (equal? (wisp->list " +a b c d e + . f g h + . i j k + +concat \"I want \" + getwish from me + . \" - \" username +") '( +(a b c d e + f g h + i j k) + +(concat "I want " + (getwish from me) + " - " username)))) + + (pass-if (equal? (wisp->list " +define : a b c +_ d e +___ f +___ g h +__ . i + +define : _ +_ display \"hello\n\" + +\\_") '( +(define (a b c) + (d e + (f) + (g h) + i)) + +(define (_) + (display "hello\n")) + +(_)))) + + ;; nesting with pairs + (pass-if (equal? (wisp->list "1 . 2\n3 4\n 5 . 6") + '((1 . 2)(3 4 (5 . 6)))))) + +(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 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Best wishes, Arne =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+sFAmTajswQHGFybmVfYmFi QHdlYi5kZQAKCRAT741FJAPD63cWD/9bdac2Lk0aPizJatzYv+Vbx7YSsbA2v3N3 1+NDEEOIiXqFCdOH0Qrm/BpnFleZms+jjfP2MifrJFDaeR9YT2bCSSdadMLUvc32 3okGptc1uflPXK5UMsynlU1Hu1AYKYBa5GmiOAvvr4KkkFctuWeFlKnRcJI0SFR1 TaN3bYr01+iBzLi4uI/Cp3KuPVKcKpx+pEs57GqFnw2z9voepAl30ei7t5wixPFB i3Qb3DCY5h1uf5/UZhnHwQybyLTKstq5amg8EiOCtyfU5x4p2XctYddVdqhUnfaq UJL87VikhGn1MlSCMB0cpciCmG5mc25/WmUjviymVovjx2yxYBYFm/4xIHSZ6qL8 g/pAjf9q8zGtB+zdIIuXOVJH0gJGWITN2PgtqVKGDQCCqu6M5UPQUn+suj9rtagM G+GYh8UVx5grvczL2MA3C5Y9ovsAv9E2yEArwD3wgtvQ86fylp/o/S/0V9590up3 C7gWaloRY3M5GDb1tI6k7KYi5lVhhA4iDSDkN35rSy1nY4Px+G8i7BPHeVhzPiNI r3zraVC+dtr9MxVQ64w1Rce6f2EI4t8rjpOCQ4gAVkQvCMFvAUSugQziF69uPbWr BOpQ6TD9IBd2Tpn2ubTFxo4VMPXSqm0ovb+z6xYnyCYYyEz7L75J5EZGYN7ySIUP OrKG4AnF3YjEBAEBCAAuFiEE3Si95tmHXKvOSosd3M8NswvBBUgFAmTajswQHGFy bmVfYmFiQHdlYi5kZQAKCRDczw2zC8EFSK8CBACcDWQvTu2JqHmA2tviXsFVMflI aUrlV+ASMyLkdTFDs3ahCIzd0QG0uWlM/EnH2T3Uzap8annMuyE1M/u+kKfUhUut LB/HNojCfe34j+UdkUgEsYo8/XNUffPHyM/UCSKaPR9LBjvnTk6B4jB7AnhGoitZ jQjC9gSj8Qr+yyzn0g== =aodF -----END PGP SIGNATURE----- --==-=-=--