(Arne Babenhauserheide)
2015-09-24: merge ending chunk with trailing period, included wisp.scm and more stable merge ending chunk with trailing period, included wisp.scm and more resilient spec.
diff --git a/.hgsigs b/.hgsigs
--- a/.hgsigs
+++ b/.hgsigs
@@ -21,3 +21,5 @@ 36b8c0daff2cd8cadb73b0dcc19c16a60f5b58eb
a8ea98c78d90ae3e1b4daaf4bab3e2a7a847a06f 0 iJwEAAEIAAYFAlUoSqEACgkQ3M8NswvBBUihJQP/XB8kHNEcsTj5pgBtMepmIX/3CmVaz6ZNgzhSzJSS1oz2DMbXPJh32QaDwRd5wCoNksD00ch7e9UWhTSZztI/yDY9KwZrTV/OIDFzIdfSsdDO4J0WNxHmgymHSfitCjHcgSvT/C9/mubhNECPrQQUx08FMnNiNvcmGpwVOwakNNw=
41a3bcb0e07cff2119e6df4574afe7af01231724 0 iQEcBAABAgAGBQJViY75AAoJEFyD82SnDaCexVAH/1TKjisW+ka4V+1Hk6L+rd+35Migij9RzfMYwfaHzi9GtpuqkDrjrRxlh8R6P/b+bHTTXwfcZ1mk6Otstsutg/469qBfF5Mb09Zoi0y4g6xt6O75Jcac8vT3Sx22hUoh0GwqRMd7DZcNjO8tTOwV0Ssraqs2VURXwIF11D9g8weconamgQqs7uWgQ4Ku6qUXFfbzv0Sk3GHCyRfzwu3IZkvXymi+sVBNmq9Wtzn14tTsgOeFSmDL8EREK/yENyckzZbxbLO8TrNmL2VeZ6SidBDOaf9nDoyh2dWYdi10dxt7lbjcaPlYXEdSxm3V7fSp8d/kF5DMuefcGThZfKsE5aM=
22bf6277df51f10ca9192bde088e6c062f9190a8 0 iQEcBAABAgAGBQJVt5NXAAoJEFyD82SnDaCevQIH/RIYkKQLBklUHMYvHO655PXNAHpU0OSMAjnggTiuNrY6IZqQASj/AWdAopPXMh5KrJ25Sg5ktlnxEw5paA68CFZCsc9HHuBwffkgN1kjOqafyI9FA46obCCnly1Mpo4814R+LbdUtcPerTDy4cJq6FlQal2l130Hi0ASVvfqqT73NbAl3EtBnYF2ecTiklHiUCZLlgMUXSBf3UxF3xzoY1g1tbtktVTVHbh+MDYPjpaM3y2CiYCaicS2kMyFRaNGEmh+4oHSAwEu9i6pZQtuhJItehbT+qNDJMc+Zs5DmYbH60Osv1mVn9MjQTeKoIWuBRHyPwuZXOstaYlNkSNqsvI=
+6ef7889cef134b20afbd9a0268b5e49c88de73c5 0 iJwEAAEIAAYFAlXzWfkACgkQ3M8NswvBBUin3QP7B9iVEOI9DRVgzXT9Na59J7comA1SQWvfmVL2sU62BI7xApRr5Oz2dTI9Do1ZN2SgIf1pn7ozW9zXgrpOD7lgXMQJ61olxbzCQYF+O42Ro2GDBLX1X/ws6aADp46geMlzomH8PFjloYZJ+bF0eKhntdIpd6rebyhr8RPYhhMCccM=
+e6a76861c5e62e5ed221fbed9edbb20033269512 0 iQEcBAABCAAGBQJWA/HXAAoJEFyD82SnDaCecvYIAKYst6/ChpZe6JWR76/kh1ybutctS/rPeuY0567TqdXdxTRbQjm88o2//R7nzBNjoQFvsFN9yQjgpUpShn1PkA27uhha5JeowD2ErPDCD5kFaGRoA/vRLPLa7BAOz87Oh9EJHkFBbWj/exHmLqauNR2H5VFyhHGafFdUcL9SqDKN6zdtDZaYdD78g+LoypvYQxUxcv4J9Ssp1or4izb/mNhCGJj063q2V7imMLAAeM8xsXycAM1re8NRLDXwo44PKvcu6B/qrNtnRr5K2QtqIrNpEWNHC0roPjwf2IzBzL0VL6LU4oK7VVghDvcqC1lid3aVrRwFRSa7UXKkb1re0V8=
diff --git a/.hgtags b/.hgtags
--- a/.hgtags
+++ b/.hgtags
@@ -30,3 +30,5 @@ 41c48043ca33bf47311a93d0545b13a0578c3cf0
a4bca2a0f2f6659d97b1db471ae9803119b80529 v0.8.4
f0096bf5f3baee5017be94f49c70515fe2a535b3 wisp-mode-0.2.1
fb551bbe7084d22ef0c8e35df3864eb2aef46005 v0.8.5
+625eec6805f907b9d6338d09c8199e9ed3e79ab1 v0.8.6
+e6977cfff0c8e0d2b1b33f724e0e4607ea15f703 v0.8.7
diff --git a/Makefile.am b/Makefile.am
--- a/Makefile.am
+++ b/Makefile.am
@@ -17,7 +17,7 @@ ChangeLog :
.INTERMEDIATE: input.in.intermediate
input.in.intermediate: ${wisp_SOURCES}
- @abs_top_srcdir@/bootstrap.sh @abs_top_srcdir@ @guile@ @python3@ 2>&1 | sed "s/^;;;.*//" 2>&1 | grep . 1>&2 ; test ! $$? -eq 0 # grep did not find anything
+ @abs_top_srcdir@/bootstrap.sh @abs_top_srcdir@ @guile@ @python3@ 2>&1 | sed "s/^;;;.*//" 2>&1 | grep . 1>&2 ; test ! $$? -eq 0 # it worked if grep does not find anything
.PHONY: syntaxtests.sh
syntaxtests.sh : wisp.scm tests/runtests-scheme-preprocessor.sh
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,21 @@
+wisp 0.8.7 (2015-09-24):
+- new example say.w, companion to
+- bootstrap now explicitly requires bash
+- include wisp.scm in the tarball to allow for pure-guile bootstrapping.
+- spec: handle locale errors more gracefully
+- improve readme
+
+wisp 0.8.6 (2015-09-12):
+- wisp-scheme.w allows ending a chunk with a trailing period. This
+ syntax is reserved for future use in SRFI-119, so you should not
+ rely on this in production code. It is mainly intended as REPL
+ feature to avoid visual clutter while running single lines, like
+ quick calculations.
+- new examples: cholesky decomposition, symmetric matrix, closure,
+ hoist-in-loop (cps transformation transcoded to wisp).
+- updated examples: evolve.w
+- clearer bootstrap output
+
wisp 0.8.5 (2015-07-28):
- wisp-scheme.w now parses : . to nothing. The colon adds parens, the
dot removes them. This provides compatibility to the older parser.
diff --git a/README b/README
--- a/README
+++ b/README
@@ -19,7 +19,7 @@ For a short presentation, see [Why Wisp?
Note that this is full-fledged scheme, with all its capabilities like hygienic macros (programmable syntax!) and full tail recursion.
-[wisp-website]: http://draketo.de/light/english/wisp-lisp-indentation-preprocessor "wisp: Whitespace to Lisp: An indentation to parentheses preprocessor to get more readable Lisp"
+[wisp-website]: http://draketo.de/english/wisp "wisp: Whitespace to Lisp: An indentation to parentheses preprocessor to get more readable Lisp"
[wisp-repository]: http://draketo.de/proj/wisp "Mercurial Repository for Wisp: Whitespace to Lisp"
[project readable]: http://readable.sourceforge.net/ "Readable Lisp S-expressions Project"
@@ -55,13 +55,13 @@ If you want to use a curly-infix express
Notes
-----
-Standardization: A [SRFI](srfi.html)[^srfi][^ess] is in the works.
+Standardization: Wisp is standardized as [SRFI 119](http://srfi.schemers.org/srfi-119/)[^srfi][^ess].
[^srfi]: SRFI is the abbreviation of Scheme Request for Implementation. It is the official schemisch way of suggesting new features. SRFIs are maintained at [srfi.schemers.org/](http://srfi.schemers.org/).
[^ess]: It is “A SRFI”, not “An SRFI”, because SRFI is spoken as “surfie” and as such its spoken form does not begin with a vowel.
-Copyright: 2013--2014 Arne Babenhauserheide
+Copyright: 2013--2015 Arne Babenhauserheide
License: GPLv3 or later
diff --git a/bootstrap.sh b/bootstrap.sh
--- a/bootstrap.sh
+++ b/bootstrap.sh
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/bin/bash
# Bootstrap wisp-guile with wisp.py
if [[ x"$1" == x"" ]]; then
diff --git a/configure.ac b/configure.ac
--- a/configure.ac
+++ b/configure.ac
@@ -1,7 +1,7 @@
dnl run `autoreconf -i` to generate a configure script.
dnl Then run ./configure to generate a Makefile.
dnl Finally run make to generate the project.
-AC_INIT([wisp], [0.8.5],
+AC_INIT([wisp], [0.8.7],
[arne_bab@web.de])
# Check for programs I need for my build
AC_CANONICAL_TARGET
diff --git a/docs/srfi-119/README b/docs/srfi-119/README
new file mode 100644
--- /dev/null
+++ b/docs/srfi-119/README
@@ -0,0 +1,22 @@
+SRFI-119 supporting files
+=========================
+
+
+Bootstrap wisp using Python 3
+-----------------------------
+
+ sh bootstrap.sh
+
+This creates wisp-preprocessor.scm (the version in the tarball is called wisp-guile.scm to avoid overwriting it)
+and wisp-parser.scm (the version in the tarball is called wisp-scheme.scm)
+
+
+Description
+-----------
+
+wisp-preprocessor.scm reads files in wisp-syntax and outputs generic scheme.
+
+ usage: guile wisp-preprocessor.scm <wisp-file> > <scheme-file>
+
+wisp-parser.scm provides procedures for reading s-expressions from wisp-files.
+
diff --git a/docs/srfi-119/bootstrap.sh b/docs/srfi-119/bootstrap.sh
new file mode 100755
--- /dev/null
+++ b/docs/srfi-119/bootstrap.sh
@@ -0,0 +1,18 @@
+#!/bin/sh
+
+# Bootstrap wisp using Python 3
+
+# This creates wisp-preprocessor.scm (the version in the tarball is called wisp-guile.scm to avoid overwriting it)
+# and wisp-parser.scm (the version in the tarball is called wisp-scheme.scm)
+
+# usage: guile wisp-preprocessor.scm <wisp-file> > <scheme-file>
+
+# wisp-parser.scm provides procedures for reading s-expressions from wisp-files.
+
+python3 wisp.py wisp-guile.w > 1 \
+ && guile 1 wisp-guile.w > 2 \
+ && guile 2 wisp-guile.w > wisp-preprocessor.scm \
+ && diff 2 wisp-preprocessor.scm \
+ && guile wisp-preprocessor.scm wisp-scheme.w > wisp-parser.scm \
+ && rm 1 2
+
diff --git a/docs/srfi-119/srfi-testsuite.html b/docs/srfi-119/srfi-testsuite.html
new file mode 100644
--- /dev/null
+++ b/docs/srfi-119/srfi-testsuite.html
@@ -0,0 +1,957 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
+<head>
+<title>Test Suite</title>
+<!-- 2014-12-23 Di 22:50 -->
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
+<meta name="generator" content="Org-mode" />
+<meta name="author" content="Arne Babenhauserheide" />
+<style type="text/css">
+ <!--/*--><![CDATA[/*><!--*/
+ .title { text-align: center; }
+ .todo { font-family: monospace; color: red; }
+ .done { color: green; }
+ .tag { background-color: #eee; font-family: monospace;
+ padding: 2px; font-size: 80%; font-weight: normal; }
+ .timestamp { color: #bebebe; }
+ .timestamp-kwd { color: #5f9ea0; }
+ .right { margin-left: auto; margin-right: 0px; text-align: right; }
+ .left { margin-left: 0px; margin-right: auto; text-align: left; }
+ .center { margin-left: auto; margin-right: auto; text-align: center; }
+ .underline { text-decoration: underline; }
+ #postamble p, #preamble p { font-size: 90%; margin: .2em; }
+ p.verse { margin-left: 3%; }
+ pre {
+ border: 1px solid #ccc;
+ box-shadow: 3px 3px 3px #eee;
+ padding: 8pt;
+ font-family: monospace;
+ overflow: auto;
+ margin: 1.2em;
+ }
+ pre.src {
+ position: relative;
+ overflow: visible;
+ padding-top: 1.2em;
+ }
+ pre.src:before {
+ display: none;
+ position: absolute;
+ background-color: white;
+ top: -10px;
+ right: 10px;
+ padding: 3px;
+ border: 1px solid black;
+ }
+ pre.src:hover:before { display: inline;}
+ pre.src-sh:before { content: 'sh'; }
+ pre.src-bash:before { content: 'sh'; }
+ pre.src-emacs-lisp:before { content: 'Emacs Lisp'; }
+ pre.src-R:before { content: 'R'; }
+ pre.src-perl:before { content: 'Perl'; }
+ pre.src-java:before { content: 'Java'; }
+ pre.src-sql:before { content: 'SQL'; }
+
+ table { border-collapse:collapse; }
+ caption.t-above { caption-side: top; }
+ caption.t-bottom { caption-side: bottom; }
+ td, th { vertical-align:top; }
+ th.right { text-align: center; }
+ th.left { text-align: center; }
+ th.center { text-align: center; }
+ td.right { text-align: right; }
+ td.left { text-align: left; }
+ td.center { text-align: center; }
+ dt { font-weight: bold; }
+ .footpara:nth-child(2) { display: inline; }
+ .footpara { display: block; }
+ .footdef { margin-bottom: 1em; }
+ .figure { padding: 1em; }
+ .figure p { text-align: center; }
+ .inlinetask {
+ padding: 10px;
+ border: 2px solid gray;
+ margin: 10px;
+ background: #ffffcc;
+ }
+ #org-div-home-and-up
+ { text-align: right; font-size: 70%; white-space: nowrap; }
+ textarea { overflow-x: auto; }
+ .linenr { font-size: smaller }
+ .code-highlighted { background-color: #ffff00; }
+ .org-info-js_info-navigation { border-style: none; }
+ #org-info-js_console-label
+ { font-size: 10px; font-weight: bold; white-space: nowrap; }
+ .org-info-js_search-highlight
+ { background-color: #ffff00; color: #000000; font-weight: bold; }
+ /*]]>*/-->
+</style>
+<script type="text/javascript">
+/*
+@licstart The following is the entire license notice for the
+JavaScript code in this tag.
+
+Copyright (C) 2012-2013 Free Software Foundation, Inc.
+
+The JavaScript code in this tag is free software: you can
+redistribute it and/or modify it under the terms of the GNU
+General Public License (GNU GPL) as published by the Free Software
+Foundation, either version 3 of the License, or (at your option)
+any later version. The code is distributed WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+
+As additional permission under GNU GPL version 3 section 7, you
+may distribute non-source (e.g., minimized or compacted) forms of
+that code without the copy of the GNU GPL normally required by
+section 4, provided you include this license notice and a URL
+through which recipients can access the Corresponding Source.
+
+
+@licend The above is the entire license notice
+for the JavaScript code in this tag.
+*/
+<!--/*--><![CDATA[/*><!--*/
+ function CodeHighlightOn(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(null != target) {
+ elem.cacheClassElem = elem.className;
+ elem.cacheClassTarget = target.className;
+ target.className = "code-highlighted";
+ elem.className = "code-highlighted";
+ }
+ }
+ function CodeHighlightOff(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(elem.cacheClassElem)
+ elem.className = elem.cacheClassElem;
+ if(elem.cacheClassTarget)
+ target.className = elem.cacheClassTarget;
+ }
+/*]]>*///-->
+</script>
+</head>
+<body>
+<div id="content">
+<h1 class="title">Test Suite</h1>
+<p>
+The wisp test-suite consists of a large number of wisp-snippets and the corresponding scheme-code.
+</p>
+
+<p>
+A wisp-implementation may call itself compliant with the wisp test-suite if the code tree parsed from the wisp file is the same as a code tree parsed from the equivalent Scheme file.
+</p>
+
+<p>
+A wisp-implementation may call itself a compliant wisp pre-processor if it successfully converts each wisp-snippet into the corresponging scheme-snippet. Blank lines at the end of the file and non-functional white-space in the produced scheme-file do not matter for this purpose.
+</p>
+
+<p>
+This test-suite is also available in the <a href="http://draketo.de/proj/wisp">wisp repository</a> along with a script-runner (runtests.sh) which tests the reference wisp-implementation with GNU Guile against this testsuite.<sup><a id="fnr.1" name="fnr.1" class="footref" href="#fn.1">1</a></sup>
+</p>
+
+<div id="outline-container-sec-1" class="outline-2">
+<h2 id="sec-1"><span class="section-number-2">1</span> tests/syntax-underscore.w</h2>
+<div class="outline-text-2" id="text-1">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">a</span> b c
+<span style="color: #0000ff;">_ d</span> e
+<span style="color: #0000ff;">___ f</span>
+<span style="color: #0000ff;">___</span> g h
+<span style="color: #0000ff;">__</span><span style="color: #a020f0;"> . </span>i
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">_</span>
+<span style="color: #0000ff;">_ display</span> <span style="color: #8b2252;">"hello\n"</span>
+
+<span style="color: #0000ff;">\_</span>
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-2" class="outline-2">
+<h2 id="sec-2"><span class="section-number-2">2</span> tests/syntax-underscore.scm</h2>
+<div class="outline-text-2" id="text-2">
+<div class="org-src-container">
+
+<pre class="src src-scheme">(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">a</span> b c)
+ (d e
+ (f)
+ (g h)
+ i))
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">_</span>)
+ (display <span style="color: #8b2252;">"hello\n"</span>))
+
+(_)
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-3" class="outline-2">
+<h2 id="sec-3"><span class="section-number-2">3</span> tests/syntax-strings-parens.w</h2>
+<div class="outline-text-2" id="text-3">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #b22222;">; </span><span style="color: #b22222;">Test linebreaks in strings and brackets</span>
+
+<span style="color: #a020f0;">. </span><span style="color: #8b2252;">"flubbub</span>
+
+<span style="color: #8b2252;">flabbab"</span>
+
+hrug (<span style="color: #0000ff;">nadda</span>
+<span style="color: #0000ff;">madda</span> gadda <span style="color: #8b2252;">"shoktom</span>
+<span style="color: #8b2252;"> mee"</span> <span style="color: #8b2252;">" sep </span>
+<span style="color: #8b2252;">ka"</span>
+<span style="color: #0000ff;"> hadda)</span>
+<span style="color: #0000ff;"> gom</span>
+
+<span style="color: #0000ff;">flu</span>
+
+<span style="color: #0000ff;">sum</span> [foo
+<span style="color: #0000ff;">bar]</span> barz {1 + [* <span style="color: #008b8b;">2</span> <span style="color: #008b8b;">2</span>]}
+
+<span style="color: #0000ff;">mara</span> {
+<span style="color: #0000ff;">li</span>
+<span style="color: #0000ff;">+</span>
+<span style="color: #0000ff;">lo</span> - (<span style="color: #0000ff;">mabba</span>)
+<span style="color: #0000ff;">}</span>
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-4" class="outline-2">
+<h2 id="sec-4"><span class="section-number-2">4</span> tests/syntax-strings-parens.scm</h2>
+<div class="outline-text-2" id="text-4">
+<div class="org-src-container">
+
+<pre class="src src-scheme"><span style="color: #b22222;">; </span><span style="color: #b22222;">Test linebreaks in strings and brackets</span>
+
+<span style="color: #8b2252;">"flubbub</span>
+
+<span style="color: #8b2252;">flabbab"</span>
+
+(hrug (nadda
+madda gadda <span style="color: #8b2252;">"shoktom</span>
+<span style="color: #8b2252;"> mee"</span> <span style="color: #8b2252;">" sep </span>
+<span style="color: #8b2252;">ka"</span>
+ hadda)
+ (gom))
+
+(flu)
+
+(sum [foo
+bar] barz {1 + [* 2 2]})
+
+(mara {
+li
++
+lo - (mabba)
+})
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-5" class="outline-2">
+<h2 id="sec-5"><span class="section-number-2">5</span> tests/syntax-indent.w</h2>
+<div class="outline-text-2" id="text-5">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #483d8b;">define</span>
+<span style="color: #0000ff;"> hello</span> who
+<span style="color: #0000ff;"> format</span> <span style="color: #008b8b;">#t</span> <span style="color: #8b2252;">"Hello ~A\n"</span> who
+
+<span style="color: #483d8b;">define</span>
+ <span style="color: #483d8b;">let</span>
+<span style="color: #a020f0;"> :</span>
+<span style="color: #0000ff;"> a</span> <span style="color: #008b8b;">1</span>
+<span style="color: #0000ff;"> b</span> <span style="color: #008b8b;">2</span>
+<span style="color: #0000ff;"> c</span> <span style="color: #008b8b;">3</span>
+<span style="color: #0000ff;"> format</span> <span style="color: #008b8b;">#t</span> <span style="color: #8b2252;">"a: ~A, b: ~A, c: ~A"</span>
+<span style="color: #0000ff;"> +</span> a <span style="color: #008b8b;">2</span>
+<span style="color: #a020f0;"> . </span> b c
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-6" class="outline-2">
+<h2 id="sec-6"><span class="section-number-2">6</span> tests/syntax-indent.scm</h2>
+<div class="outline-text-2" id="text-6">
+<div class="org-src-container">
+
+<pre class="src src-scheme">(<span style="color: #a020f0;">define</span>
+ (hello who)
+ (format #t <span style="color: #8b2252;">"Hello ~A\n"</span> who))
+
+(<span style="color: #a020f0;">define</span>
+ (<span style="color: #a020f0;">let</span>
+ (
+ (a 1)
+ (b 2)
+ (c 3))
+ (format #t <span style="color: #8b2252;">"a: ~A, b: ~A, c: ~A"</span>
+ (+ a 2)
+ b c)))
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-7" class="outline-2">
+<h2 id="sec-7"><span class="section-number-2">7</span> tests/syntax-empty.w</h2>
+<div class="outline-text-2" id="text-7">
+<div class="org-src-container">
+
+<pre class="src src-wisp"></pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-8" class="outline-2">
+<h2 id="sec-8"><span class="section-number-2">8</span> tests/syntax-empty.scm</h2>
+<div class="outline-text-2" id="text-8">
+<div class="org-src-container">
+
+<pre class="src src-scheme"></pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-9" class="outline-2">
+<h2 id="sec-9"><span class="section-number-2">9</span> tests/syntax-dot.w</h2>
+<div class="outline-text-2" id="text-9">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">foo</span>
+<span style="color: #a020f0;"> . </span><span style="color: #8b2252;">"bar"</span>
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">bar</span>
+<span style="color: #0000ff;"> '</span> <span style="color: #008b8b;">1</span>
+<span style="color: #a020f0;"> . . </span><span style="color: #008b8b;">2</span> <span style="color: #b22222;">; </span><span style="color: #b22222;">pair</span>
+
+<span style="color: #0000ff;">display</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">foo</span>
+<span style="color: #0000ff;">newline</span>
+<span style="color: #0000ff;">display</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">bar</span>
+<span style="color: #0000ff;">newline</span>
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-10" class="outline-2">
+<h2 id="sec-10"><span class="section-number-2">10</span> tests/syntax-dot.scm</h2>
+<div class="outline-text-2" id="text-10">
+<div class="org-src-container">
+
+<pre class="src src-scheme">(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">foo</span>)
+ <span style="color: #8b2252;">"bar"</span>)
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">bar</span>)
+ '(1
+ . 2 ))<span style="color: #b22222;">; </span><span style="color: #b22222;">pair</span>
+
+(display (foo))
+(newline)
+(display (bar))
+(newline)
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-11" class="outline-2">
+<h2 id="sec-11"><span class="section-number-2">11</span> tests/syntax-colon.w</h2>
+<div class="outline-text-2" id="text-11">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #483d8b;">let</span>
+<span style="color: #a020f0;"> :</span>
+<span style="color: #0000ff;"> a</span> <span style="color: #008b8b;">1</span>
+<span style="color: #0000ff;"> b</span> <span style="color: #008b8b;">2</span>
+ <span style="color: #483d8b;">let</span>
+<span style="color: #a020f0;"> :</span>
+<span style="color: #a020f0;"> :</span>
+<span style="color: #a020f0;"> . </span>c <span style="color: #008b8b;">3</span>
+<span style="color: #0000ff;"> format</span> <span style="color: #008b8b;">#t</span> <span style="color: #8b2252;">"a: ~A, b: ~A, c: ~A"</span>
+<span style="color: #a020f0;"> . </span> a b c
+
+<span style="color: #a020f0;">: </span>a
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">hello</span>
+<span style="color: #0000ff;"> display</span> <span style="color: #8b2252;">"hello\n"</span>
+
+<span style="color: #483d8b;">let</span>
+<span style="color: #a020f0;"> : </span><span style="color: #0000ff;">a</span> <span style="color: #008b8b;">1</span>
+<span style="color: #0000ff;"> b</span> <span style="color: #008b8b;">2</span>
+<span style="color: #0000ff;"> format</span> <span style="color: #008b8b;">#t</span> <span style="color: #8b2252;">"a: ~A, b: ~A"</span>
+<span style="color: #a020f0;"> . </span> a b
+
+<span style="color: #483d8b;">let</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">:</span> a ' :
+
+<span style="color: #483d8b;">let</span>
+<span style="color: #a020f0;"> : </span> <span style="color: #b22222;">; </span><span style="color: #b22222;">foo</span>
+<span style="color: #0000ff;"> a</span>
+ '
+
+<span style="color: #a020f0;">:</span>
+ a
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">\:</span>
+<span style="color: #0000ff;"> hello</span>
+
+<span style="color: #0000ff;">\:</span>
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-12" class="outline-2">
+<h2 id="sec-12"><span class="section-number-2">12</span> tests/syntax-colon.scm</h2>
+<div class="outline-text-2" id="text-12">
+<div class="org-src-container">
+
+<pre class="src src-scheme">(<span style="color: #a020f0;">let</span>
+ (
+ (a 1)
+ (b 2))
+ (<span style="color: #a020f0;">let</span>
+ (
+ (
+ c 3))
+ (format #t <span style="color: #8b2252;">"a: ~A, b: ~A, c: ~A"</span>
+ a b c)))
+
+((a))
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">hello</span>)
+ (display <span style="color: #8b2252;">"hello\n"</span>))
+
+(<span style="color: #a020f0;">let</span>
+ ((a 1)
+ (b 2))
+ (format #t <span style="color: #8b2252;">"a: ~A, b: ~A"</span>
+ a b))
+
+(<span style="color: #a020f0;">let</span> ((a '())))
+
+(<span style="color: #a020f0;">let</span>
+ ( <span style="color: #b22222;">; </span><span style="color: #b22222;">foo</span>
+ (a
+ '())))
+
+(
+ (a))
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">:</span>)
+ (hello))
+
+(:)
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-13" class="outline-2">
+<h2 id="sec-13"><span class="section-number-2">13</span> tests/sublist.w</h2>
+<div class="outline-text-2" id="text-13">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #b22222;">; </span><span style="color: #b22222;">sublists allow to start single line function calls with a colon ( : ).</span>
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">a</span> b c
+ <span style="color: #483d8b;">let</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">:</span> e<span style="color: #a020f0;"> . </span>f
+<span style="color: #a020f0;"> . </span>g
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-14" class="outline-2">
+<h2 id="sec-14"><span class="section-number-2">14</span> tests/sublist.scm</h2>
+<div class="outline-text-2" id="text-14">
+<div class="org-src-container">
+
+<pre class="src src-scheme"><span style="color: #b22222;">; </span><span style="color: #b22222;">sublists allow to start single line function calls with a colon ( : ).</span>
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">a</span> b c)
+ (<span style="color: #a020f0;">let</span> ((e . f))
+ g))
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-15" class="outline-2">
+<h2 id="sec-15"><span class="section-number-2">15</span> tests/hashbang.w</h2>
+<div class="outline-text-2" id="text-15">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #b22222;">#!/usr/bin/wisp.py # !#</span>
+<span style="color: #b22222;">; </span><span style="color: #b22222;">This tests hashbang lines</span>
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-16" class="outline-2">
+<h2 id="sec-16"><span class="section-number-2">16</span> tests/hashbang.scm</h2>
+<div class="outline-text-2" id="text-16">
+<div class="org-src-container">
+
+<pre class="src src-scheme">#!/usr/bin/wisp.py # !#
+<span style="color: #b22222;">; </span><span style="color: #b22222;">This tests hashbang lines</span>
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-17" class="outline-2">
+<h2 id="sec-17"><span class="section-number-2">17</span> tests/readable-tests.w</h2>
+<div class="outline-text-2" id="text-17">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">fibfast</span> n
+ <span style="color: #483d8b;">if</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;"><</span> n <span style="color: #008b8b;">2</span>
+<span style="color: #a020f0;"> . </span>n
+<span style="color: #0000ff;"> fibup</span> n <span style="color: #008b8b;">2</span> <span style="color: #008b8b;">1</span> <span style="color: #008b8b;">0</span>
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">fibup</span> maxnum count n-1 n-2
+ <span style="color: #483d8b;">if</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">=</span> maxnum count
+<span style="color: #0000ff;"> +</span> n-1 n-2
+<span style="color: #0000ff;"> fibup</span> maxnum
+<span style="color: #0000ff;"> +</span> count <span style="color: #008b8b;">1</span>
+<span style="color: #0000ff;"> +</span> n-1 n-2
+<span style="color: #a020f0;"> . </span>n-1
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">factorial</span> n
+ <span style="color: #483d8b;">if</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;"><=</span> n <span style="color: #008b8b;">1</span>
+<span style="color: #a020f0;"> . </span><span style="color: #008b8b;">1</span>
+<span style="color: #0000ff;"> *</span> n
+<span style="color: #0000ff;"> factorial</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">-</span> n <span style="color: #008b8b;">1</span>
+
+<span style="color: #483d8b;">define</span> (<span style="color: #0000ff;">gcd</span> x y)
+ <span style="color: #483d8b;">if</span> (<span style="color: #0000ff;">=</span> y <span style="color: #008b8b;">0</span>)
+<span style="color: #a020f0;"> . </span>x
+<span style="color: #0000ff;"> gcd</span> y
+<span style="color: #0000ff;"> rem</span> x y
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">add-if-all-numbers</span> lst
+<span style="color: #0000ff;"> call/cc</span>
+<span style="color: #0000ff;"> lambda</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">exit</span>
+ <span style="color: #483d8b;">let</span> loop
+<span style="color: #a020f0;"> : </span>
+<span style="color: #0000ff;"> lst</span> lst
+<span style="color: #0000ff;"> sum</span> <span style="color: #008b8b;">0</span>
+ <span style="color: #483d8b;">if</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">null?</span> lst
+<span style="color: #a020f0;"> . </span>sum
+ <span style="color: #483d8b;">if</span><span style="color: #a020f0;"> : </span><span style="color: #483d8b;">not</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">number?</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">car</span> lst
+<span style="color: #0000ff;"> exit</span> <span style="color: #008b8b;">#f</span>
+<span style="color: #0000ff;"> +</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">car</span> lst
+<span style="color: #0000ff;"> loop</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">cdr</span> lst
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-18" class="outline-2">
+<h2 id="sec-18"><span class="section-number-2">18</span> tests/readable-tests.scm</h2>
+<div class="outline-text-2" id="text-18">
+<div class="org-src-container">
+
+<pre class="src src-scheme">(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">fibfast</span> n)
+ (<span style="color: #a020f0;">if</span> (< n 2))
+ n
+ (fibup n 2 1 0 ))
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">fibup</span> maxnum count n-1 n-2)
+ (<span style="color: #a020f0;">if</span> (= maxnum count)
+ (+ n-1 n-2)
+ (fibup maxnum
+ (+ count 1 )
+ (+ n-1 n-2 )
+ n-1)))
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">factorial</span> n)
+ (<span style="color: #a020f0;">if</span> (<= n 1)
+ 1
+ (* n
+ (factorial (- n 1)))))
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">gcd</span> x y)
+ (<span style="color: #a020f0;">if</span> (= y 0))
+ x
+ (gcd y
+ (rem x y)))
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">add-if-all-numbers</span> lst)
+ (<span style="color: #a020f0;">call/cc</span>
+ (<span style="color: #a020f0;">lambda</span> (exit)
+ (<span style="color: #a020f0;">let</span> <span style="color: #0000ff;">loop</span>
+ (
+ (lst lst )
+ (sum 0))
+ (<span style="color: #a020f0;">if</span> (null? lst)
+ sum
+ (<span style="color: #a020f0;">if</span> (not (number? (car lst)))
+ (exit #f)
+ (+ (car lst)
+ (loop (cdr lst)))))))))
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-19" class="outline-2">
+<h2 id="sec-19"><span class="section-number-2">19</span> tests/quotecolon.w</h2>
+<div class="outline-text-2" id="text-19">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #b22222;">#!/home/arne/wisp/wisp-multiline.sh </span>
+<span style="color: #b22222;">; </span><span style="color: #b22222;">!#</span>
+<span style="color: #483d8b;">define</span> a <span style="color: #008b8b;">1</span> <span style="color: #b22222;">; </span><span style="color: #b22222;">test whether ' : correctly gets turned into '(</span>
+<span style="color: #b22222;">; </span><span style="color: #b22222;">and whether brackets in commments are treated correctly.</span>
+
+<span style="color: #483d8b;">define</span> a '<span style="color: #a020f0;"> : </span><span style="color: #0000ff;">1</span> <span style="color: #008b8b;">2</span> <span style="color: #008b8b;">3</span>
+
+<span style="color: #483d8b;">define</span>
+<span style="color: #0000ff;"> a</span> b
+<span style="color: #0000ff;"> c</span>
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-20" class="outline-2">
+<h2 id="sec-20"><span class="section-number-2">20</span> tests/quotecolon.scm</h2>
+<div class="outline-text-2" id="text-20">
+<div class="org-src-container">
+
+<pre class="src src-scheme">#!/home/arne/wisp/wisp-multiline.sh
+<span style="color: #b22222;">; </span><span style="color: #b22222;">!#</span>
+(<span style="color: #a020f0;">define</span> <span style="color: #0000ff;">a</span> 1 )<span style="color: #b22222;">; </span><span style="color: #b22222;">test whether ' : correctly gets turned into '(</span>
+<span style="color: #b22222;">; </span><span style="color: #b22222;">and whether brackets in commments are treated correctly.</span>
+
+(<span style="color: #a020f0;">define</span> <span style="color: #0000ff;">a</span> '(1 2 3))
+
+(<span style="color: #a020f0;">define</span>
+ (a b)
+ (c))
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-21" class="outline-2">
+<h2 id="sec-21"><span class="section-number-2">21</span> tests/namedlet.w</h2>
+<div class="outline-text-2" id="text-21">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #b22222;">#!/home/arne/wisp/wisp-multiline.sh </span>
+<span style="color: #b22222;">; </span><span style="color: #b22222;">!#</span>
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">hello</span> who
+<span style="color: #0000ff;"> display</span> who
+
+<span style="color: #483d8b;">let</span> hello
+<span style="color: #a020f0;"> : </span><span style="color: #0000ff;">who</span> <span style="color: #008b8b;">0</span>
+ <span style="color: #483d8b;">if</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">=</span> who <span style="color: #008b8b;">5</span>
+<span style="color: #0000ff;"> display</span> who
+<span style="color: #0000ff;"> hello</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">+</span> <span style="color: #008b8b;">1</span> who
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-22" class="outline-2">
+<h2 id="sec-22"><span class="section-number-2">22</span> tests/namedlet.scm</h2>
+<div class="outline-text-2" id="text-22">
+<div class="org-src-container">
+
+<pre class="src src-scheme">#!/home/arne/wisp/wisp-multiline.sh
+<span style="color: #b22222;">; </span><span style="color: #b22222;">!#</span>
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">hello</span> who)
+ (display who))
+
+(<span style="color: #a020f0;">let</span> <span style="color: #0000ff;">hello</span>
+ ((who 0))
+ (<span style="color: #a020f0;">if</span> (= who 5)
+ (display who)
+ (hello (+ 1 who))))
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-23" class="outline-2">
+<h2 id="sec-23"><span class="section-number-2">23</span> tests/flexible-parameter-list.w</h2>
+<div class="outline-text-2" id="text-23">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #b22222;">; </span><span style="color: #b22222;">Test using a . as first parameter on a line by prefixing it with a second .</span>
+<span style="color: #483d8b;">define</span>
+<span style="color: #0000ff;"> a</span> i
+<span style="color: #a020f0;"> . . </span>b
+<span style="color: #0000ff;"> unless</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">>=</span> i<span style="color: #a020f0;"> : </span><span style="color: #0000ff;">length</span> b
+<span style="color: #0000ff;"> display</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">number->string</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">length</span> b
+<span style="color: #0000ff;"> display</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">list-ref</span> b i
+<span style="color: #0000ff;"> newline</span>
+<span style="color: #0000ff;"> apply</span> a ( <span style="color: #0000ff;">+</span> i <span style="color: #008b8b;">1</span> ) b
+
+
+<span style="color: #0000ff;">a</span> <span style="color: #008b8b;">0</span> <span style="color: #8b2252;">"123"</span> <span style="color: #8b2252;">"345"</span> <span style="color: #8b2252;">"567"</span>
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-24" class="outline-2">
+<h2 id="sec-24"><span class="section-number-2">24</span> tests/flexible-parameter-list.scm</h2>
+<div class="outline-text-2" id="text-24">
+<div class="org-src-container">
+
+<pre class="src src-scheme"><span style="color: #b22222;">; </span><span style="color: #b22222;">Test using a . as first parameter on a line by prefixing it with a second .</span>
+(<span style="color: #a020f0;">define</span>
+ (a i
+ . b)
+ (unless (>= i (length b))
+ (display (number->string (length b )))
+ (display (list-ref b i))
+ (newline)
+ (apply a ( + i 1 ) b)))
+
+
+(a 0 <span style="color: #8b2252;">"123"</span> <span style="color: #8b2252;">"345"</span> <span style="color: #8b2252;">"567"</span>)
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-25" class="outline-2">
+<h2 id="sec-25"><span class="section-number-2">25</span> tests/factorial.w</h2>
+<div class="outline-text-2" id="text-25">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #b22222;">;; </span><span style="color: #b22222;">short version</span>
+<span style="color: #b22222;">; </span><span style="color: #b22222;">note: once you use one inline colon, all the following forms on that</span>
+<span style="color: #b22222;">; </span><span style="color: #b22222;">line will get closed at the end of the line</span>
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">factorial</span> n
+ <span style="color: #483d8b;">if</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">zero?</span> n
+<span style="color: #a020f0;"> . </span><span style="color: #008b8b;">1</span>
+<span style="color: #0000ff;"> *</span> n<span style="color: #a020f0;"> : </span><span style="color: #0000ff;">factorial</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">-</span> n <span style="color: #008b8b;">1</span>
+
+<span style="color: #0000ff;">display</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">factorial</span> <span style="color: #008b8b;">5</span>
+
+
+<span style="color: #b22222;">;; </span><span style="color: #b22222;">more vertical space, less colons</span>
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">factorial</span> n
+ <span style="color: #483d8b;">if</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">zero?</span> n
+<span style="color: #a020f0;"> . </span><span style="color: #008b8b;">1</span>
+<span style="color: #0000ff;"> *</span> n
+<span style="color: #0000ff;"> factorial</span>
+<span style="color: #0000ff;"> -</span> n <span style="color: #008b8b;">1</span>
+
+<span style="color: #0000ff;">display</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">factorial</span> <span style="color: #008b8b;">5</span>
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-26" class="outline-2">
+<h2 id="sec-26"><span class="section-number-2">26</span> tests/factorial.scm</h2>
+<div class="outline-text-2" id="text-26">
+<div class="org-src-container">
+
+<pre class="src src-scheme"><span style="color: #b22222;">;; </span><span style="color: #b22222;">short version</span>
+<span style="color: #b22222;">; </span><span style="color: #b22222;">note: once you use one inline colon, all the following forms on that</span>
+<span style="color: #b22222;">; </span><span style="color: #b22222;">line will get closed at the end of the line</span>
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">factorial</span> n)
+ (<span style="color: #a020f0;">if</span> (zero? n)
+ 1
+ (* n (factorial (- n 1)))))
+
+(display (factorial 5 ))
+
+
+<span style="color: #b22222;">;; </span><span style="color: #b22222;">more vertical space, less colons</span>
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">factorial</span> n)
+ (<span style="color: #a020f0;">if</span> (zero? n)
+ 1
+ (* n
+ (factorial
+ (- n 1)))))
+
+(display (factorial 5 ))
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-27" class="outline-2">
+<h2 id="sec-27"><span class="section-number-2">27</span> tests/example.w</h2>
+<div class="outline-text-2" id="text-27">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #483d8b;">define</span> (<span style="color: #0000ff;">a</span> b c)
+ <span style="color: #483d8b;">let</span>
+<span style="color: #a020f0;"> : </span>
+<span style="color: #0000ff;"> d</span> <span style="color: #8b2252;">"i am a string</span>
+<span style="color: #8b2252;">do not break me!"</span>
+<span style="color: #a020f0;"> : </span>
+ <span style="color: #b22222;">; </span><span style="color: #b22222;">comment: 0</span>
+ f
+<span style="color: #b22222;">; </span><span style="color: #b22222;">comment : 1</span>
+<span style="color: #0000ff;"> `</span> g <span style="color: #b22222;">; </span><span style="color: #b22222;">comment " : " 2</span>
+<span style="color: #a020f0;"> : </span>
+<span style="color: #0000ff;"> h</span> (<span style="color: #0000ff;">I</span> am in brackets:
+<span style="color: #0000ff;"> do</span> <span style="color: #483d8b;">not</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">change</span> <span style="color: #8b2252;">"me"</span>)
+<span style="color: #a020f0;"> . </span>i
+<span style="color: #0000ff;"> ,</span><span style="color: #008b8b;"> 'j</span> k
+
+<span style="color: #a020f0;"> . </span>l
+
+<span style="color: #b22222;">; </span><span style="color: #b22222;">comment</span>
+
+<span style="color: #0000ff;"> a</span> c
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">b</span> :n o
+<span style="color: #a020f0;"> . </span><span style="color: #8b2252;">"second defun : with a docstring!"</span>
+<span style="color: #0000ff;"> message</span> <span style="color: #8b2252;">"I am here"</span>
+<span style="color: #a020f0;"> . </span>t
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">c</span> e f
+<span style="color: #a020f0;"> : </span><span style="color: #0000ff;">g</span>
+<span style="color: #a020f0;"> :</span>
+<span style="color: #0000ff;"> h</span>
+<span style="color: #0000ff;"> i</span>
+<span style="color: #0000ff;"> j</span>
+<span style="color: #0000ff;"> '</span> :
+<span style="color: #0000ff;"> k</span>
+<span style="color: #a020f0;"> . </span>l
+<span style="color: #a020f0;"> . </span>: <span style="color: #0000ff;">m</span>
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">_</span> \:
+<span style="color: #0000ff;">__</span>
+<span style="color: #0000ff;">__</span><span style="color: #a020f0;"> . </span>\:
+
+<span style="color: #0000ff;">\_</span> b
+
+<span style="color: #483d8b;">define</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">d</span>
+ <span style="color: #483d8b;">let</span>
+<span style="color: #a020f0;"> : </span><span style="color: #0000ff;">a</span> b
+<span style="color: #0000ff;"> c</span> d
+
+<span style="color: #0000ff;">a</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">:</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">c</span>
+
+<span style="color: #483d8b;">let</span>
+<span style="color: #a020f0;"> : </span><span style="color: #0000ff;">a</span> b
+ c
+
+<span style="color: #483d8b;">let</span><span style="color: #a020f0;"> : </span><span style="color: #0000ff;">:</span> a b
+
+<span style="color: #a020f0;">. </span>a
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-28" class="outline-2">
+<h2 id="sec-28"><span class="section-number-2">28</span> tests/example.scm</h2>
+<div class="outline-text-2" id="text-28">
+<div class="org-src-container">
+
+<pre class="src src-scheme">(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">a</span> b c)
+ (<span style="color: #a020f0;">let</span>
+ (
+ (d <span style="color: #8b2252;">"i am a string</span>
+<span style="color: #8b2252;">do not break me!"</span>)
+ (
+ <span style="color: #b22222;">; </span><span style="color: #b22222;">comment: 0</span>
+ (f)
+<span style="color: #b22222;">; </span><span style="color: #b22222;">comment : 1</span>
+ `(g ))<span style="color: #b22222;">; </span><span style="color: #b22222;">comment " : " 2</span>
+ (
+ (h (I am in brackets:
+ do not : change <span style="color: #8b2252;">"me"</span>))
+ i)))
+ ,('j k)
+
+ l
+
+<span style="color: #b22222;">; </span><span style="color: #b22222;">comment</span>
+
+ (a c))
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">b</span> <span style="color: #483d8b;">:n</span> o)
+ <span style="color: #8b2252;">"second defun : with a docstring!"</span>
+ (message <span style="color: #8b2252;">"I am here"</span>)
+ t)
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">c</span> e f)
+ ((g))
+ (
+ (h
+ (i))
+ (j))
+ '(())
+ (k)
+ l
+ (m))
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">_</span> :)
+
+ :)
+
+(_ b)
+
+(<span style="color: #a020f0;">define</span> (<span style="color: #0000ff;">d</span>)
+ (<span style="color: #a020f0;">let</span>
+ ((a b)
+ (c d))))
+
+(a (((c))))
+
+(<span style="color: #a020f0;">let</span>
+ ((a b)
+ (c)))
+
+(<span style="color: #a020f0;">let</span> ((a b)))
+
+a
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-29" class="outline-2">
+<h2 id="sec-29"><span class="section-number-2">29</span> tests/continuation.w</h2>
+<div class="outline-text-2" id="text-29">
+<div class="org-src-container">
+
+<pre class="src src-wisp"><span style="color: #0000ff;">a</span> b c d e
+<span style="color: #a020f0;"> . </span>f g h
+<span style="color: #a020f0;"> . </span>i j k
+
+<span style="color: #0000ff;">concat</span> <span style="color: #8b2252;">"I want "</span>
+<span style="color: #0000ff;"> getwish</span> from me
+<span style="color: #a020f0;"> . </span><span style="color: #8b2252;">" - "</span> username
+</pre>
+</div>
+</div>
+</div>
+<div id="outline-container-sec-30" class="outline-2">
+<h2 id="sec-30"><span class="section-number-2">30</span> tests/continuation.scm</h2>
+<div class="outline-text-2" id="text-30">
+<div class="org-src-container">
+
+<pre class="src src-scheme">(a b c d e
+ f g h
+ i j k)
+
+(concat <span style="color: #8b2252;">"I want "</span>
+ (getwish from me)
+ <span style="color: #8b2252;">" - "</span> username)
+</pre>
+</div>
+</div>
+</div>
+<div id="footnotes">
+<h2 class="footnotes">Footnotes: </h2>
+<div id="text-footnotes">
+
+<div class="footdef"><sup><a id="fn.1" name="fn.1" class="footnum" href="#fnr.1">1</a></sup> <p>
+To run the tests in the wisp testsuite with a separately built GNU Guile, you can use any given guile interpreter by adjusting the following command: <code>PATH=~/guile-2.0.11/meta:${PATH} ./runtests.sh</code>
+</p></div>
+
+
+</div>
+</div></div>
+<div id="postamble" class="status">
+<p class="author">Author: Arne Babenhauserheide</p>
+<p class="date">Created: 2014-12-23 Di 22:50</p>
+<p class="creator"><a href="http://www.gnu.org/software/emacs/">Emacs</a> 24.3.1 (<a href="http://orgmode.org">Org</a> mode 8.2.6)</p>
+<p class="validation"><a href="http://validator.w3.org/check?uri=referer">Validate</a></p>
+</div>
+</body>
+</html>
diff --git a/docs/srfi-119/wisp-bootstrap.py b/docs/srfi-119/wisp-bootstrap.py
new file mode 100755
--- /dev/null
+++ b/docs/srfi-119/wisp-bootstrap.py
@@ -0,0 +1,405 @@
+#!/usr/bin/env python3
+# wisp.py --- Whitespace-to-Lisp preprocessor.
+
+# Copyright (C) 2013 Arne Babenhauserheide <arne_bab@web.de>
+
+# Author: Arne Babenhauserheide <arne_bab@web.de>
+
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 3
+# of the License, or (at your option) any later version.
+
+# This program 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+"""whitespace to lisp converter.
+
+Essentially it just adds brackets for indentation to allow writing
+lisp with indentation senstitive syntax.
+
+Currently it is written in Python, because I like Python as language,
+but crave the power of lisp.
+"""
+
+def replaceinwisp(code, string, replacement):
+ """Replace the given string with the replacement, but only in
+ indentation sensitive parts of the code.
+
+ Essentially replace everywhere except in brackets or strings.
+
+ :param code: Arbitrary wisp code to process.
+ :param string: A string to replace.
+ :param replacement: The replacement string.
+
+ :return: (code, count): The new code and a count of replacements.
+ """
+ count = 0
+ instring = False
+ incomment = False
+ inbrackets = 0
+ strlen = len(string)
+ for n in range(len(code) - strlen):
+ i = code[n]
+ # comments start with a ; - but only in regular wisp code or in brackets.
+ if not incomment and not instring and i == ";" and not code[n-2:n] == "#\\":
+ incomment = not incomment
+ # a linebreak ends the comment
+ if incomment:
+ if i == "\n":
+ incomment = not incomment
+ # all processing stops in comments
+ continue
+ # FIXME: This still breaks at "\\"
+ if i == '"' and (not code[n-1:n] == "\\" or (code[n-2:n] == "\\\\" and not code[n-3:n] == "\\\\\\")):
+ instring = not instring
+ # all processing stops in strings
+ if instring:
+ continue
+ if i == "(" and not code[n-2:n] == "#\\":
+ inbrackets += 1
+ elif i == ")" and not code[n-2:n] == "#\\":
+ inbrackets -= 1
+ # all processing stops in brackets
+ if inbrackets:
+ continue
+ # here we do the actual replacing
+ if code[n:n+strlen] == string:
+ count += 1
+ code = code[:n] + replacement + code[n+strlen:]
+ return code, count
+
+
+class UndefinedIndentationLevel(IndentationError):
+ """Unindent does not match any outer indentation level."""
+
+
+class Line:
+ def __init__(self, line):
+ """Parse one line in which linebreaks within strings and
+ brackets already got replaced by a temporary placeholder."""
+ # Visible indentation: If the line starts with any number of
+ # _, followed by a space, treat those _ as spaces.
+ if line.startswith("_"):
+ for i,letter in enumerate(line):
+ if letter != "_":
+ # rewind the index to the last underscore
+ i -= 1
+ break
+ # increment the index to the first
+ # non-underscore. Required to treat end of string and end
+ # of underscores the same
+ i += 1
+ # here line[i-1] is _. Check if line[i+1] is a space or if
+ # the line ends after the last underscore
+ if line[i:i+1] == " " or not line[i:]:
+ line = (i)*" " + line[i:]
+ # \_ escapes the underscore at the beginning of a line, so you
+ # can use identifiers which only consist of underscores.
+ elif line.startswith("\_"):
+ line = "_" + line[2:]
+
+ #: prefix to go around the outer bracket: '(, ,( or `(
+ self.prefix = ""
+ # check if this is a continuation of the parent line
+ self.continues = line.lstrip().startswith(". ")
+ if self.continues:
+ self.content = line.lstrip()[2:].lstrip()
+ else:
+ self.content = line.lstrip()
+ # check if the line is prefixed with any combination of ' ` and ,
+ if not self.continues:
+ while (self.content.startswith("' ") or
+ self.content.startswith(", ") or
+ self.content.startswith("` ") or
+ self.content.startswith("#, ") or # scheme macros
+ self.content.startswith("#` ") or
+ self.content.startswith("#' ") or
+ self.content.startswith("#,@, ")):
+ self.prefix += self.content.split(" ")[0]
+ self.content = self.content[2:]
+
+ # care for lines starting with ": " (a colon followed by a space and more chars)
+ self.indent = len(line) - len(line.lstrip())
+ if self.content.startswith(": ") and self.content[2:].lstrip():
+ # just add a space in front of the " : ". Then it will be
+ # captured by as inline : later. With this, the following are almost equal:
+ # ": a b" and
+ # ":
+ # a b"
+
+ # The only difference between both is that ": a b" cannot
+ # have siblings in subsequent lines: The function call
+ # ends on this line.
+ self.content = " " + self.content
+
+ if self.content.strip() == ":" or self.content.strip() == "":
+ self.content = ""
+
+ # split a possible comment
+ self.comment = ""
+ instring = False
+ for n, i in enumerate(self.content):
+ if i == '"' and not self.content[n-1:n] == "\\":
+ instring = not instring
+ if not instring and i == ";" and not self.content[n-2:n] == "#\\":
+ self.comment = self.content[n+1:]
+ self.content = self.content[:n]
+ break
+
+ # treat inline " : " as opening a bracket which gets closed at
+ # the end of the line if the : is at the end of the line, add
+ # () to avoid being dependent on whitespace at the end of the
+ # line.
+ bracketstoclose = 0
+ instring = False
+ inbrackets = 0
+ # go backwards through the content to be able to leave out the
+ # space after a colon without breaking later colons.
+ for n, i in reversed(list(enumerate(self.content))):
+ if i == '"' and not self.content[n-1:n] == "\\":
+ instring = not instring
+ if not instring and i == ")" and not self.content[n-2:n] == "#\\":
+ inbrackets += 1
+ elif not instring and i == "(" and not self.content[n-2:n] == "#\\":
+ inbrackets -= 1
+ if (not instring and
+ not inbrackets and
+ i == ":" and # optimization to be able to avoid string
+ # slicing when there can be no hit.
+ n # avoid content[-1:2] (which is an unnecessary
+ # slicing, since it is always ""
+ ):
+ if self.content[n-1:n+2] == " : " or self.content[n-1:] == " :":
+ bracketstoclose += 1
+ # treat ' : as '(
+ if self.content[n-3:n+1] == " ' :":
+ self.content = self.content[:n-2] + "'(" + self.content[n+2:]
+ else:
+ # we have to keep the space after the colon (" : "
+ # → " ( "), otherwise we cannot use two
+ # consecutive colons (" : : ") which would be surprising.
+ self.content = self.content[:n] + "(" + self.content[n+2:]
+
+ # after the full line processing, replace " \\: " "\n\\: " and
+ # " \\:\n" (inside line, start of a line, end of a line) by "
+ # : ", "\n: " and " :\n" respectively to allow escaping : as
+ # expression.
+ self.content, count = replaceinwisp(self.content, " \\: ", " : ")
+ if self.content.startswith("\\: "):
+ self.content = ": " + self.content[3:]
+ elif self.content.endswith(" \\:"):
+ self.content = self.content[:-3] + " :"
+ elif self.content == "\\:": # empty function or variable call
+ self.content = ":"
+
+ # add closing brackets
+ self.content += ")" * bracketstoclose
+
+ #: Is the line effectively empty?
+ self.empty = False
+ onlycomment = (line.split(";")[1:] and # there is content after the comment sign
+ not line.split(";")[0].count('"') % 2 and # but the first comment sign is not in a string
+ not line.split(";")[0].strip()) # there is no content before the comment sign
+ if line.strip() == "" or onlycomment:
+ self.empty = True
+
+
+def nostringbreaks(code):
+ """remove linebreaks inside strings (will be readded at the end)"""
+ instring = False
+ nostringbreaks = []
+ for n, char in enumerate(code):
+ if char == '"' and not code[n-1:n] == "\\":
+ instring = not instring
+ if instring and char == "\n":
+ nostringbreaks.append("\\LINEBREAK")
+ else:
+ nostringbreaks.append(char)
+ return "".join(nostringbreaks)
+
+
+def nobracketbreaks(code):
+ """remove linebreaks inside brackets (will be readded at the end)."""
+ instring = False
+ incomment = False
+ inbracket = 0
+ nostringbreaks = []
+ for n, char in enumerate(code):
+ # comments start with a ; - but only in regular wisp code or in brackets.
+ if not incomment and not instring and char == ";" and not code[n-2:n] == "#\\":
+ incomment = not incomment
+ # a linebreak ends the comment
+ if incomment:
+ if char == "\n":
+ incomment = not incomment
+ # all processing stops in comments
+ nostringbreaks.append(char)
+ continue
+ if char == '"' and not code[n-1:n] == "\\":
+ instring = not instring
+ if char == '(' and not instring and not code[n-2:n] == "#\\":
+ inbracket += 1
+ elif char == ')' and not instring and not code[n-2:n] == "#\\":
+ inbracket -= 1
+ if inbracket and char == "\n":
+ nostringbreaks.append("\\LINEBREAK")
+ else:
+ nostringbreaks.append(char)
+ return "".join(nostringbreaks)
+
+
+def processlines(lines, prev, codestartindex, levels, lisplines, emptylines):
+ """Process all lines after the first."""
+ # process further lines: adjust the content of the current line, but only append
+ for n, line in enumerate(lines[codestartindex+1:]):
+ n += codestartindex + 2
+ # ignore empty lines and comment-only lines
+ if line.empty:
+ # simply keep empty lines and ignore their indentation
+ # readd a possible comment
+ if line.comment:
+ line.content += ";" + line.comment
+ # keep the line, do not track it in any way
+ emptylines.append(line.indent * " " + line.content)
+ continue
+
+ # care for leading brackets
+ # continuing lines do not get a leading bracket.
+ if not line.continues:
+ line.content = line.prefix + "(" + line.content
+
+ # care for closing brackets
+ # rising indent: sibling function or variable
+ if line.indent > prev.indent:
+ levels.append(line.indent)
+ lisplines.append(prev.indent * " " + prev.content)
+ # same indent: neighbour function of variable: close the previour lines bracket
+ if line.indent == prev.indent:
+ if not prev.continues:
+ lisplines.append(prev.indent * " " + prev.content + ")")
+ else:
+ lisplines.append(prev.indent * " " + prev.content)
+ # lower indent: parent funtion or variable. Find the number of brackets to close
+ if prev.indent > line.indent:
+ bracketstoclose = len([level for level in levels if level >= line.indent])
+ if not line.indent in levels[-bracketstoclose:]:
+ raise UndefinedIndentationLevel("Unindent of line " + str(n) + " does not match any outer indentation level.\n" + line.indent*" " + "|\n" + line.indent*" " + "v\n" + line.indent*" " + line.content)
+ levels = levels[:-bracketstoclose + 1]
+ if prev.continues:
+ bracketstoclose -= 1
+ lisplines.append(prev.indent * " " + prev.content + ")" * bracketstoclose)
+
+ # add a possible comment
+ if prev.comment:
+ lisplines[-1] += ";" + prev.comment
+
+ prev = line
+ lisplines.extend(emptylines)
+ emptylines = []
+
+ # postprocessing the loop.
+ if prev and prev.continues:
+ levels.pop()
+ if prev:
+ lisplines.append(prev.indent * " " + prev.content + ")" * (len(levels)))
+ lisplines.extend(emptylines)
+ return prev, lisplines, emptylines, levels
+
+
+def wisp2lisp(code):
+ """Turn wisp code to lisp code."""
+ # TODO: extract the shebang before preprocessing the code.
+
+ # if the code is empty, just return an empty string
+ if not code:
+ return code
+
+ # first get rid of linebreaks in strings
+ code = nostringbreaks(code)
+ # and of linebreaks inside brackets
+ code = nobracketbreaks(code)
+
+ # now read the indentation
+ lines = []
+ for line in code.splitlines():
+ lines.append(Line(line))
+
+ # finally emit matching lisp code
+ # write into the lisp lines with a delay of 1 line
+ lisplines = []
+ # effectively empty lines to be appended
+ emptylines = []
+ levels = [0]
+ prev = lines[0]
+ #: The index of the first code line
+ codestartindex = 0
+
+ # process the first lines in the file.
+
+ # Shebang lines must be used verbatim
+ if not prev.indent and prev.content.startswith("#!"):
+ codestartindex += 1
+ if prev.comment:
+ prev.content += ";" + prev.comment
+ lisplines.append(prev.content)
+ if codestartindex < len(lines):
+ prev = lines[codestartindex]
+ else:
+ prev = None
+
+ # initial comment lines need special treatment to avoid starting
+ # them with () (implementation detail)
+ while prev and prev.empty:
+ codestartindex += 1
+ if prev.comment:
+ prev.content += ";" + prev.comment
+ lisplines.append(prev.indent * " " + prev.content)
+ if codestartindex < len(lines):
+ prev = lines[codestartindex]
+ else:
+ prev = None
+ if prev and not prev.continues:
+ prev.content = prev.prefix + "(" + prev.content
+
+ # run the linereader loop. This does the main work - aside from
+ # the preprocessing in the Line class.
+ if prev:
+ prev, lisplines, emptylines, levels = processlines(lines, prev, codestartindex,
+ levels, lisplines, emptylines)
+
+ # postprocessing the resulting lisplines: the loop is not perfect…
+ # get rid of brackets around empty lines
+ for n,i in enumerate(lisplines):
+ if i.lstrip() == "()":
+ lisplines[n] = ""
+
+ return "\n".join(lisplines).replace("\\LINEBREAK", "\n")
+
+
+if __name__ == "__main__":
+ import sys
+ import optparse
+ parser = optparse.OptionParser("[-o outfile] [file | -]")
+ parser.add_option("-o", "--output", default="")
+ opts, args = parser.parse_args()
+ if args:
+ sourcefile = args[0]
+ else:
+ sourcefile = "example.w"
+ # accept stdin as input
+ if sourcefile == "-":
+ wisp = sys.stdin.read()
+ else:
+ with open(sourcefile) as f:
+ wisp = f.read()
+ if opts.output:
+ with open(opts.output, "w") as f:
+ f.write(wisp2lisp(wisp) + "\n")
+ else:
+ print(wisp2lisp(wisp))
diff --git a/docs/srfi-119/wisp-guile.scm b/docs/srfi-119/wisp-guile.scm
new file mode 100644
--- /dev/null
+++ b/docs/srfi-119/wisp-guile.scm
@@ -0,0 +1,835 @@
+#!/home/arne/wisp/wisp-multiline.sh
+; !#
+
+;; This file might need to be licensed permissively for inclusion in
+;; an SRFI. Only change it, if you agree to this possible relicensing
+;; of your contribution to this file. I will not accept changes here
+;; which do not allow that.
+
+; we need to be able to replace end-of-line characters in brackets and strings
+
+;; TODO: Check whether I can offload the string processing to the
+;; read-function. That’s a source of endless complications. Required:
+;; A kind of unrolling step which appends the string-representation of
+;; the read strings back into the code. I would have to process a list
+;; of strings instead of one big string. Or rather, each line would be
+;; a list of strings.
+
+;; bootstrap via python3 wisp.py wisp-guile.w > 1 && guile 1 wisp-guile.w > 2 && guile 2 wisp-guile.w > 3 && diff 2 3
+;;
+;; -Author: Arne Babenhauserheide
+
+;; Copyright (C) Arne Babenhauserheide (2013--2015). All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+
+(define-module (wisp)
+ #:export (wisp2lisp wisp-chunkreader))
+
+(use-modules
+ ((srfi srfi-1))
+ ((ice-9 regex)))
+
+(define (endsinunevenbackslashes text ); comment
+ (if (= 0 (string-length text))
+ #f
+ (let counter
+ ((last (string-take-right text 1))
+ (rest (string-append " " (string-drop-right text 1)))
+ (count 0))
+ (cond
+ ((= 0 (string-length rest )); end clause: read all
+ (odd? count))
+ ; end clause: no \
+ ((not (equal? last (string #\\)))
+ (odd? count))
+ (else
+ (counter (string-take-right rest 1) (string-drop-right rest 1) (+ 1 count)))))))
+
+
+(define (nostringandbracketbreaks inport)
+ "Replace all linebreaks inside strings and brackets with placeholders."
+ (let ((expressions (list (nostringandbracketbreaksreader inport))))
+ (while (not (eof-object? (peek-char inport)))
+ (set! expressions (append expressions (list (nostringandbracketbreaksreader inport)))))
+ (string-join expressions "\n")))
+
+
+(define (nostringandbracketbreaksreader inport)
+ "Read one wisp-expression from the inport.
+Ends with three consecutive linebreaks or eof."
+ ; Replace end of line characters in brackets and strings
+ ; FIXME: Breaks if the string is shorter than 2 chars
+ ; FIXME: Breaks if the text begins with a comment.
+ (let*
+ ((lastchar (read-char inport))
+ (nextchar (read-char inport))
+ (text (if (eof-object? lastchar) "" (string lastchar)))
+ (incomment #f)
+ (incommentfirstchar #f ); first char of a comment
+ (instring #f)
+ (inbrackets 0)
+ (incharform 0 )); #\<something>
+ (while
+ (not
+ (or (eof-object? nextchar)
+ (and
+ (or (char=? nextchar #\newline ) (char=? nextchar #\return ) )
+ (or (char=? lastchar #\newline ) (char=? lastchar #\return ) )
+ (string-suffix? "\n\n" text )))); text includes lastchar
+ ; incommentfirstchar is only valid for exactly one char
+ (when incommentfirstchar (set! incommentfirstchar #f ))
+ ; but add incommentfirstchar if we just started the text
+ (when (equal? text ";" ); initial comment
+ (set! incommentfirstchar #f)
+ (set! incomment #t)
+ (set! text (string-append text "\\REALCOMMENTHERE")))
+ ; already started char forms win over everything, so process them first.
+ ; already started means: after the #\
+ ; FIXME: Fails to capture #t and #f which can kill line splitting if it happens inside brackets
+ (when (= incharform 1)
+ (when (not (and (char=? lastchar #\# ) (or (char=? #\f nextchar) (char=? #\t nextchar))))
+ ; format #t "1: set incharform 0: lastchar ~a nextchar ~a instring ~a incomment ~a incharform ~a" lastchar nextchar instring incomment incharform
+ ; newline
+ (set! incharform 0)))
+
+ (when (>= incharform 2)
+ (if (or (char=? nextchar #\space) (char=?
+ nextchar #\newline ) (char=? nextchar #\return ) )
+ (begin
+ ; format #t "2: set incharform 0: lastchar ~a nextchar ~a instring ~a incomment ~a incharform ~a" lastchar nextchar instring incomment incharform
+ ; newline
+ (set! incharform 0))
+ ; else
+ (set! incharform (+ incharform 1))))
+ ; check if we switch to a string: last char is space, linebreak or in a string, not in a charform, not in a comment
+ (when
+ (and
+ (char=? nextchar #\")
+ (not incomment)
+ (< incharform 1)
+ (or
+ (and
+ instring ; when I’m in a string, I can get out
+ (or
+ (not (char=? lastchar #\\ )); if the last char is not a backslash (escaped quote)
+ ; or the last char is a backslash preceded by an uneven number of backslashes (so the backslash is actually an escaped backslash)
+ (and (char=? lastchar #\\)
+ ; not : equal? #f : string-match "\\([^\\]\\)+\\(\\\\\\\\\\)*[\\]$" text ; matches [^\](\\)*\$ - non-backslash + arbitrary number of pairs of backslashes + final backslash which undoes the escaping from the lastchar (by actually escaping the lastchar)
+ (endsinunevenbackslashes text))))
+ (char=? lastchar #\space ); when the last char was a space, I can get into a string
+ (char=? lastchar #\newline ); same for newline chars
+ (char=? lastchar #\return )
+ (and (not instring ); outside of strings, brackets are pseudo-whitespace, too
+ (or
+ (char=? lastchar #\( )
+ (char=? lastchar #\))
+ (char=? lastchar #\[ )
+ (char=? lastchar #\])
+ ; TODO: Only match for braces {} if curly infix is enabled
+ (char=? lastchar #\{ )
+ (char=? lastchar #\})))))
+ (set! instring (not instring)))
+ ; check if we switch to a comment
+ (when
+ (and
+ ; FIXME: this should be
+ ; char=? nextchar #\;
+ (equal? ";" (string nextchar))
+ (not incomment)
+ (not instring)
+ (< incharform 2))
+ (set! incomment #t)
+ (set! incommentfirstchar #t)
+ ; this also closes any potential charform
+ (set! incharform 0))
+ (when
+ (and incomment
+ (or
+ (char=? nextchar #\return)
+ (char=? nextchar #\newline)))
+ (set! incomment #f))
+
+ ; check for the beginning of a charform
+ (when
+ (and
+ (not instring)
+ (not incomment)
+ (char=? lastchar #\space)
+ (char=? nextchar #\#))
+ (set! incharform 1))
+ ; check whether a charform is continued
+ (when
+ (and
+ (= incharform 1)
+ (char=? lastchar #\#)
+ (char=? nextchar #\\))
+ (set! incharform 2))
+
+ ; check for brackets
+ ; FIXME: This only fixes a single linebreak inside parens, but if a second occurs on the same line it breaks. I do not know why. Maybe something with having lastchar as linebreak.
+ (when (not (or instring incomment))
+ (when
+ (and
+ (not (string-suffix? text "#"))
+ (not (char=? #\\ lastchar))
+ (not (endsinunevenbackslashes (string-drop-right text (min 1 (string-length text))))))
+ ; TODO: Only match for braces {} if curly infix is enabled
+ ; FIXME: Catch wrong ordering of parens/brackets/braces like ({)}
+ (when (or (equal? "[" (string nextchar)) (equal? "(" (string nextchar)) (equal? "{" (string nextchar)))
+ (set! inbrackets (+ inbrackets 1)))
+ (when (or (equal? "}" (string nextchar)) (equal? ")" (string nextchar)) (equal? "]" (string nextchar)))
+ (set! inbrackets (- inbrackets 1)))))
+ (if (or instring (> inbrackets 0))
+ (if (char=? nextchar #\newline)
+ ; we have to actually construct the escape
+ ; sequence here to be able to parse ourselves.
+ (set! text (string-append text (string-append "\\LINE_" "BREAK_N")))
+ (if (char=? nextchar #\return)
+ (set! text (string-append text (string-append "\\LINE_" "BREAK_R")))
+ ; else
+ (set! text (string-append text (string nextchar)))))
+ ; mark the start of a comment, so we do not have to
+ ; repeat the string matching in later code. We include
+ ; the comment character!
+ ; not (instring or inbrackets) = neither instring nor inbrackets
+ (if incommentfirstchar
+ (set! text (string-append text ( string nextchar ) "\\REALCOMMENTHERE"))
+ ; when not in brackets or string or starting a
+ ; comment: just append the char
+ (set! text (string-append text (string nextchar)))))
+
+ (set! lastchar nextchar)
+ (set! nextchar (read-char inport)))
+ ; return the text
+ text))
+
+
+; As next part we have split a text into a list of lines which we can process one by one.
+(define (splitlines inport )
+ (let
+ ((lines '())
+ (nextchar (read-char inport))
+ (nextline ""))
+ (while (not (eof-object? nextchar))
+ (if (not (or (char=? nextchar #\return ) (char=? nextchar #\newline )))
+ (set! nextline (string-append nextline (string nextchar)))
+ (begin
+ (set! lines (append lines (list nextline)))
+ (set! nextline "")))
+ (set! nextchar (read-char inport)))
+ (append lines (list nextline))))
+
+(define (line-indent line)
+ (list-ref line 0))
+
+(define (line-content line)
+ (list-ref line 1))
+
+(define (line-comment line)
+ (list-ref line 2))
+
+(define (line-continues? line)
+ "Check whether the line is a continuation of a previous line (should not start with a bracket)."
+ (if (equal? #f (line-content line))
+ #f ; this is the EOF line. It does not continue (to ensure that the last brackets get closed)
+ (string-prefix? ". " (line-content line))))
+
+(define (line-empty-code? line)
+ "Check whether the code-part of the line is empty: contains only whitespace and/or comment."
+ (equal? "" (line-content line)))
+
+(define (line-only-colon? line)
+ "Check whether the line content consists only of a colon and whitespace."
+ (equal? ":" (string-trim-right (line-content line))))
+
+(define (line-only-prefix? line prefix)
+ "Check whether the line content consists only of a given prefix and whitespace."
+ (equal? prefix (string-trim-right (line-content line))))
+
+(define (line-merge-comment line)
+ "Merge comment and content into the content. Return the new line."
+ (let
+ ((indent (line-indent line))
+ (content (line-content line))
+ (comment (line-comment line)))
+ (if (equal? "" comment)
+ line ; no change needed
+ (list indent (string-append content ";" comment)
+ ""))))
+
+
+; skip the leading indentation
+(define (skipindent inport)
+ (let skipper
+ ((inunderbars #t)
+ (indent 0)
+ (nextchar (read-char inport)))
+ ; when the file ends, do not do anything else
+ (if (not (eof-object? nextchar ))
+ ; skip underbars
+ (if inunderbars
+ (if (char=? nextchar #\_ ); still in underbars?
+ (skipper
+ #t ; still in underbars?
+ (+ indent 1)
+ (read-char inport))
+ ; else, reevaluate without inunderbars
+ (skipper #f indent nextchar))
+ ; else: skip remaining spaces
+ (if (char=? nextchar #\space)
+ (skipper
+ #f
+ (+ indent 1)
+ (read-char inport))
+ (begin
+ (unread-char nextchar inport)
+ indent)))
+ indent)))
+
+
+; Now we have to split a single line into indentation, content and comment.
+(define (splitindent inport)
+ (let
+ ((indent (skipindent inport)))
+ (let
+ ((nextchar (read-char inport))
+ (inindent #t ); it always begins in indent
+ (incomment #f ); but not in a comment
+ (commentstart #f)
+ (commentstartidentifier "\\REALCOMMENTHERE")
+ (commentstartidentifierlength 16)
+ (commentidentifierindex 0)
+ (content "")
+ (comment ""))
+ (while (not (eof-object? nextchar))
+ ; check whether we leave the content
+ ; FIXME: (wisp.py) the reader cuts the ; here, when I write it as this:
+ ; when : and ( not incomment ) : char=? nextchar #\;
+ ; FIXME: THIS mistreats #\; as comment! (shown 4 lines after this comment…)
+ (when
+ (and
+ (not incomment)
+ ; FIXME: this should be but would break
+ ; char=? nextchar #\;
+ (equal? ";" (string nextchar))
+ (not (string-suffix? ( string #\# #\\ ) content)))
+ (set! commentstart #t)
+ (set! comment (string-append comment (string nextchar)))
+ (set! nextchar (read-char inport))
+ (continue))
+ ; check whether we stay in the commentcheck
+ (when (and commentstart (char=? nextchar (string-ref commentstartidentifier commentidentifierindex)))
+
+ (set! commentidentifierindex (+ commentidentifierindex 1))
+ (set! comment (string-append comment (string nextchar)))
+ (when (= commentidentifierindex commentstartidentifierlength)
+ (set! commentstart #f)
+ (set! incomment #t)
+ ; reset used variables
+ (set! commentidentifierindex 0)
+ (set! comment ""))
+ (set! nextchar (read-char inport))
+ (continue))
+ ; if we cannot complete the commentcheck, we did not start a real comment. Append it to the content
+ (when (and commentstart (not (char=? nextchar (string-ref commentstartidentifier commentidentifierindex))))
+ (set! commentstart #f)
+ (set! content (string-append content comment (string nextchar)))
+ (set! comment "")
+ (set! commentidentifierindex 0)
+ (set! nextchar (read-char inport))
+ (continue))
+ ; if we are in the comment, just append to the comment
+ (when incomment
+ (set! comment (string-append comment (string nextchar)))
+ (set! nextchar (read-char inport))
+ (continue))
+ ; if nothing else is true, we are in the content
+ (set! content (string-append content (string nextchar)))
+ (set! nextchar (read-char inport)))
+ (when commentstart
+ (set! content (string-append content comment))
+ (set! comment ""))
+ ; return the indentation, the content and the comment
+ (list indent content comment))))
+
+
+; Now use the function to split a list of lines
+(define (linestoindented lines)
+ (let splitter
+ ((unprocessed lines)
+ (processed '()))
+ (if (equal? unprocessed '())
+ processed
+ ; else: let-recursion
+ (splitter
+ (list-tail unprocessed 1)
+ (append processed
+ (list
+ (call-with-input-string
+ (list-ref unprocessed 0)
+ splitindent)))))))
+
+
+(define (read-whole-file filename)
+ (let ((origfile (open-file filename "r")))
+ (let reader
+ ((text "")
+ (nextchar (read-char origfile)))
+ (if (eof-object? nextchar)
+ text
+ (reader
+ (string-append text (string nextchar))
+ (read-char origfile))))))
+
+
+
+(define (wisp2lisp-add-inline-colon-brackets line)
+ "Add inline colon brackets to a wisp-line (indent,content,comment).
+
+A line with only a colon and whitespace gets no additional parens!
+
+Also unescape \\: to :.
+"
+ ; if the line only consists of a colon and whitespace, do not change it.
+ (if (line-only-colon? line)
+ line
+ (let ((content (line-content line)))
+ ; replace final " :" by a function call. There we are by definition of the line-splitting not in a string.
+ (when (string-suffix? " :" content)
+ (set! content (string-append (string-drop-right content 1) "()")))
+ ; process the content in reverse direction, so we can detect ' : and turn it into '(
+ ; let linebracketizer ( ( instring #f ) ( inbrackets 0 ) ( bracketstoadd 0 ) ( unprocessed content ) ( processed "" ) )
+ (let linebracketizer (( instring #f ) ( inbrackets 0 ) ( bracketstoadd 0 ) ( unprocessed content ) ( processed "" ) )
+ (if (< (string-length unprocessed) 2)
+ ; if unprocessed is < 2 chars, it cannot contain ": ". We are done.
+ (list
+ (line-indent line)
+ (string-append unprocessed processed (xsubstring ")" 0 bracketstoadd))
+ (line-comment line))
+ ; else
+ (let
+ ((lastletter (string-take-right unprocessed 1))
+ (lastupto3 (string-take-right unprocessed (min 3 (string-length unprocessed))))
+ (lastupto4 (string-take-right unprocessed (min 4 (string-length unprocessed))))
+ (lastupto6 (string-take-right unprocessed (min 6 (string-length unprocessed)))))
+ ; check if we’re in a string
+ (when
+ (or
+ (and
+ (not instring)
+ (equal? "\"" lastletter)
+ (not (equal? "#\\\"" lastupto3)))
+ (and
+ instring
+ (equal? "\"" lastletter)
+ (not (endsinunevenbackslashes (string-drop-right unprocessed 1)))))
+ (set! instring (not instring)))
+ (when (not instring)
+ (when
+ (or
+ ; TODO: Only match for braces {} if curly infix is enabled
+ ; FIXME: Catch wrong ordering of parens/brackets/braces like ({)}
+ (and (equal? "{" lastletter) (not (equal? "#\\{" lastupto3)))
+ (and (equal? "[" lastletter) (not (equal? "#\\[" lastupto3)))
+ (and (equal? "(" lastletter) (not (equal? "#\\(" lastupto3))))
+ (set! inbrackets (- inbrackets 1)))
+ (when
+ (or
+ (and (equal? ")" lastletter) (not (equal? "#\\)" lastupto3)))
+ (and (equal? "]" lastletter) (not (equal? "#\\]" lastupto3)))
+ (and (equal? "}" lastletter) (not (equal? "#\\}" lastupto3))))
+ (set! inbrackets (+ 1 inbrackets )))); remember that we're going backwards!
+ ; error handling: inbrackets must never be smaller than 0 - due to the line splitting.
+ (when (< inbrackets 0)
+ (throw 'more-inline-brackets-closed-than-opened inbrackets line))
+ ; when we’re in a string or in brackets , just skip to the next char
+ (cond
+ ((or instring (> inbrackets 0))
+ (linebracketizer instring inbrackets bracketstoadd
+ (string-drop-right unprocessed 1)
+ (string-append lastletter processed)))
+ ; else check for " : ": That adds a new inline bracket
+ ; support : at the beginning of a line, too.
+ ((or (equal? " : " lastupto3) (equal? ": " lastupto3))
+ ; replace the last 2 chars with "(" and note
+ ; that we need an additional closing bracket
+ ; at the end.
+ (linebracketizer instring inbrackets (+ 1 bracketstoadd )
+ (string-append (string-drop-right unprocessed 2) )
+ (string-append "(" processed)))
+ ; turn " ' (" into " '(", do not modify unprocessed, except to shorten it!
+ ; same for ` , #' #` #, #,@,
+ ((and (string-prefix? "(" processed) (equal? " ' " lastupto3))
+ ; leave out the second space
+ (linebracketizer instring inbrackets bracketstoadd
+ (string-append (string-drop-right unprocessed 2) "'")
+ processed))
+ ((and (string-prefix? "(" processed) (equal? " , " lastupto3))
+ ; leave out the second space
+ (linebracketizer instring inbrackets bracketstoadd
+ (string-append (string-drop-right unprocessed 2) ",")
+ processed))
+ ((and (string-prefix? "(" processed) (equal? " ` " lastupto3))
+ ; leave out the second space
+ (linebracketizer instring inbrackets bracketstoadd
+ (string-append (string-drop-right unprocessed 2) "`")
+ processed))
+ ((and (string-prefix? "(" processed) (equal? " #` " lastupto4))
+ ; leave out the second space
+ (linebracketizer instring inbrackets bracketstoadd
+ (string-append (string-drop-right unprocessed 3) "#`")
+ processed))
+ ((and (string-prefix? "(" processed) (equal? " #' " lastupto4))
+ ; leave out the second space
+ (linebracketizer instring inbrackets bracketstoadd
+ (string-append (string-drop-right unprocessed 3) "#'")
+ processed))
+ ((and (string-prefix? "(" processed) (equal? " #, " lastupto4))
+ ; leave out the second space
+ (linebracketizer instring inbrackets bracketstoadd
+ (string-append (string-drop-right unprocessed 3) "#,")
+ processed))
+ ((and (string-prefix? "(" processed) (equal? " #,@, " lastupto6))
+ ; leave out the second space
+ (linebracketizer instring inbrackets bracketstoadd
+ (string-append (string-drop-right unprocessed 5) "#,@,")
+ processed))
+ (else ; just go on
+ (linebracketizer instring inbrackets bracketstoadd
+ (string-drop-right unprocessed 1)
+ (string-append lastletter processed))))))))))
+
+
+(define (last-indent levels)
+ "Retrieve the indentation of the last line: Simply the highest level."
+ (list-ref levels 0))
+
+(define (line-add-starting-bracket line)
+ "Add a starting bracket to the line, if it is no continuation line (it is more indented than the previous).
+
+If line starts with one of ' , ` #` #' #, #,@, then turn it into '(... instead of ('...
+
+If line is indented and only contains : and optional whitespace, remove the :.
+
+The line *must* have a whitespace after the prefix, except if the prefix is the only non-whitespace on the line."
+ ; if the line only contains a colon, we just replace its content with an opening paren.
+ (if (line-only-colon? line ); FIXME: Check for this somewhere else.
+ (list
+ (line-indent line)
+ (string-append "(" (string-drop (line-content line) 1 )); keep whitespace
+ (line-comment line))
+ (let loop ((paren-prefixes (list "' " ", " "` " "#` " "#' " "#, " "#,@, ")))
+ ; first check whether we are done checking
+ (if (null-list? paren-prefixes)
+ ; construct the line structure: '(indentation-depth content comment)
+ (list
+ (line-indent line)
+ (string-append
+ "("
+ (line-content line))
+ (line-comment line))
+ ; otherwise check all possible prefixes
+ (let*
+ ((prefix (car paren-prefixes))
+ (prefix-no-space (string-drop-right prefix 1)))
+ (cond
+ ((string-prefix? prefix (line-content line))
+ (list
+ (line-indent line)
+ (string-append
+ prefix-no-space "("
+ (string-drop (line-content line) (string-length prefix)))
+ (line-comment line)))
+ ((line-only-prefix? line prefix-no-space)
+ (list
+ (line-indent line)
+ (string-append
+ (string-drop-right prefix 1) "("
+ (string-drop (line-content line) (string-length prefix-no-space)))
+ (line-comment line)))
+ (else
+ (loop (cdr paren-prefixes)))))))))
+
+(define (line-add-closing-brackets line number)
+ "Add a closing bracket to the line."
+ (list
+ (line-indent line)
+ (string-append
+ (line-content line)
+ (xsubstring ")" 0 number))
+ (line-comment line)))
+
+(define (line-indent-brackets-to-close line-indent levels line-continues prev-continues)
+ "Find the number of brackets to close to reduce the levels to the line-indent."
+ ; adjust the levels until the highest indentation level is equal
+ ; to the indentation of the next line. Then check for
+ ; continuation.
+ (let closer ((bracketstoclose 0) (rest levels))
+ (let ((highest-level (list-ref rest 0)))
+ ; finish-condition
+ (if (= line-indent highest-level)
+ (if prev-continues
+ bracketstoclose
+ (+ 1 bracketstoclose))
+ (if (> line-indent highest-level)
+ (closer (- bracketstoclose 1) (append (list line-indent) rest ))
+ (closer (+ bracketstoclose 1) (list-tail rest 1)))))))
+
+
+(define (line-indent-brackets-to-open line-indent levels line-continues prev-continues)
+ "Find the number of brackets to open to fit the line-indent and continuation marker."
+ (if line-continues
+ 0
+ 1))
+
+(define (line-indent-levels-adjust levels next-indent)
+ "Add or remove levels so the highest remaining level matches next-indent."
+ (let adjuster ((lev levels))
+ (let ((highest-level (list-ref lev 0)))
+ (if (= next-indent highest-level)
+ lev
+ (if (> next-indent highest-level)
+ (append (list next-indent) lev)
+ (adjuster (list-tail lev 1)))))))
+
+(define (line-drop-continuation-dot line)
+ (let ((content (line-content line)))
+ (list
+ (line-indent line)
+ (if (line-continues? line)
+ (string-drop content 2)
+ content)
+ (line-comment line ))))
+
+(define (wisp2lisp-parse lisp prev lines)
+ "Parse the body of the wisp-code."
+ (set! prev (wisp2lisp-add-inline-colon-brackets prev )); prev already is a code-line.
+ (if (not (or (line-continues? prev) (line-empty-code? prev)))
+ (set! prev (line-add-starting-bracket prev)))
+ (set! lines (map-in-order wisp2lisp-add-inline-colon-brackets lines))
+ (let bracketizer ((levels '(0)) (pre prev) (unprocessed lines) (processed lisp) (whitespace '()))
+ ; levels is the list of levels, with the lowest to the right. i.e: '(12 8 4 0)
+ ; once we processed everything, we pass the bracketizer pre as f one last time
+ (if (equal? #f (line-content pre))
+ processed
+ (let ((next (if (equal? unprocessed '()) (list 0 #f #f) (list-ref unprocessed 0 )))); this is the break condition for the next loop!
+ (if (line-empty-code? next ); empty lines get silently added, but otherwise ignored
+ (bracketizer levels pre
+ (list-tail unprocessed 1)
+ processed
+ (append whitespace (list next)))
+ ; firstoff add the next indent to the levels, so we only work on the levels, prev-continues, next-continues and next-indent
+ ; if pre was a continuation, the real levels are 1 lower than the counted levels
+ (let*
+ ((next-indent (line-indent next))
+ (pre-indent (line-indent pre))
+ (pre-continues (line-continues? pre))
+ (next-continues (line-continues? next))
+ (final-line (equal? #f (line-content next)))
+ (bracketstocloseprev (if (line-empty-code? pre) 0 (line-indent-brackets-to-close next-indent levels next-continues pre-continues)))
+ (bracketstoopennext (line-indent-brackets-to-open next-indent levels next-continues pre-continues))
+ (newnext (if final-line next (if (> bracketstoopennext 0) (line-add-starting-bracket next) next)))
+ (newpre (line-drop-continuation-dot (line-add-closing-brackets pre bracketstocloseprev)))
+ (newlevels (line-indent-levels-adjust levels next-indent)))
+ (bracketizer newlevels newnext
+ (if final-line unprocessed (list-tail unprocessed 1))
+ (append processed (list newpre) whitespace)
+ (list))))))))
+
+
+(define (wisp2lisp-initial-comments lisp prev lines)
+ "Keep all starting comments: do not start them with a bracket."
+ (let skip-initial-comments ((lisp lisp) (prev prev) (lines lines))
+ (if (= 0 (length lines )); file only contained comments, maybe including the hashbang
+ (list lisp prev lines)
+ (if (line-empty-code? prev)
+ (skip-initial-comments (append lisp (list prev))
+ (list-ref lines 0) (list-tail lines 1))
+ (list lisp prev lines)))))
+
+(define (wisp2lisp-hashbang lisp prev unprocessed)
+ "Parse a potential initial hashbang line."
+ (if
+ (and
+ (equal? lisp '() ); really the first line
+ (equal? 0 (line-indent prev))
+ (string-prefix? "#!" (line-content prev)))
+ (wisp2lisp-hashbang (append lisp (list (line-merge-comment prev)))
+ (list-ref unprocessed 0) (list-tail unprocessed 1))
+ (list lisp prev unprocessed)))
+
+(define (wisp2lisp-lines lines)
+ "Parse indentation in the lines to add the correct brackets."
+ (if (equal? lines '())
+ '()
+ (let
+ ((lisp '() ); the processed lines
+ (prev (list-ref lines 0 )); the last line
+ (unprocessed (list-tail lines 1 ))); obvious :)
+ (let*
+ ((hashbanged (wisp2lisp-hashbang lisp prev unprocessed))
+ (deinitialized (apply wisp2lisp-initial-comments hashbanged))
+ (parsed (apply wisp2lisp-parse deinitialized)))
+ parsed))))
+
+(define (line-unescape-underscore-and-colon line)
+ "Unescape underscores at the beginning of the line and colon."
+ (let loop
+ ((processed "")
+ (unprocessed (line-content line)))
+ (if (equal? "" unprocessed)
+ (list
+ (line-indent line)
+ processed
+ (line-comment line))
+ (let
+ ((next (string (string-ref unprocessed 0))))
+ (if (equal? "" processed )
+ (cond
+ ; get rid of \_
+ ((string-prefix? "(\\_" unprocessed)
+ (loop processed (string-append "(" (string-drop unprocessed 2))))
+ ; get rid of \:
+ ((string-prefix? "(\\:" unprocessed)
+ (loop processed (string-append "(" (string-drop unprocessed 2))))
+ ; get rid of . \:
+ ((string-prefix? "\\:" unprocessed)
+ (loop processed (string-drop unprocessed 1)))
+ (else
+ (loop
+ (string-append processed next)
+ (string-drop unprocessed 1))))
+ (cond
+ ((string-prefix? " \\:" unprocessed)
+ (loop
+ (string-append processed " :" )
+ (string-drop unprocessed 3)))
+ ((string-prefix? "(\\:" unprocessed)
+ (loop
+ (string-append processed "(:" )
+ (string-drop unprocessed 3)))
+ (else
+ (loop
+ (string-append processed next)
+ (string-drop unprocessed 1)))))))))
+
+(define (unescape-underscore-and-colon lines)
+ "Unescape underscores at the beginning of each line and colon."
+ (let loop
+ ((processed '())
+ (unprocessed lines))
+ (if (equal? unprocessed '())
+ processed
+ (let ((current (car unprocessed)))
+ (loop
+ (append processed (list (line-unescape-underscore-and-colon current)))
+ (cdr unprocessed))))))
+
+
+
+(define* (string-replace-substring s substr replacement #:optional (start 0) (end (string-length s)))
+ "Replace every instance of substring in s by replacement."
+ (let ((substr-length (string-length substr)))
+ (if (zero? substr-length)
+ (error "string-replace-substring: empty substr")
+ (let loop
+ ((start start)
+ (pieces (list (substring s 0 start))))
+ (let ((idx (string-contains s substr start end)))
+ (if idx
+ (loop (+ idx substr-length)
+ (cons* replacement
+ (substring s start idx)
+ pieces))
+ (string-concatenate-reverse
+ (cons (substring s start)
+ pieces))))))))
+
+
+(define (unescape-linebreaks text)
+ "unescape linebreaks"
+ (string-replace-substring
+ ; we have to construct the placeholders here to avoid unescaping them when we parse ourselves…
+ (string-replace-substring text (string-append "\\LINE_" "BREAK_N") (string #\newline))
+ (string-append "\\LINE_" "BREAK_R")
+ (string #\return )))
+
+
+(define (unescape-comments text)
+ "unescape comments"
+ (string-replace-substring text
+ ; we have to construct the placeholders here to avoid unescaping them when we parse ourselves…
+ (string-append ";" "\\REALCOMMENTHERE")
+ ";"))
+
+
+(define (wisp-chunkreader inport)
+ "Read one wisp-expression from inport, without escaping of fake newlines but with correct detection of real new lines.
+ Realized by reading with newline and comment escaping and unescaping both again after reading."
+ (unescape-comments
+ (unescape-linebreaks
+ (nostringandbracketbreaksreader inport))))
+
+
+(define (join-lisp-lines lisp-lines)
+ (let join ((joined "") (unprocessed lisp-lines))
+ (if (not (equal? unprocessed '()))
+ (let*
+ ((next (list-ref unprocessed 0))
+ (nextstring
+ (string-append
+ (xsubstring " " 0 (line-indent next))
+ ; here we re-add all necessary linebreakswe get rid
+ (unescape-linebreaks (line-content next))
+ (if (equal? "" (line-comment next ))
+ ""
+ (string-append ";" (line-comment next)))
+ "\n")))
+ (join (string-append joined nextstring) (list-tail unprocessed 1)))
+ joined)))
+
+(define (wisp2lisp text )
+ (let*
+ ((nobreaks (call-with-input-string text nostringandbracketbreaks))
+ (textlines (call-with-input-string nobreaks splitlines))
+ (lines (linestoindented textlines))
+ (lisp-lines (wisp2lisp-lines lines))
+ (clean-lines (unescape-underscore-and-colon lisp-lines)))
+ (join-lisp-lines clean-lines)))
+
+ ; first step: Be able to mirror a file to stdout
+(if (< 1 (length (command-line)))
+ (let*
+ ((filename (list-ref ( command-line ) 1))
+ (text (read-whole-file filename))
+ ; Lines consist of lines with indent, content and comment. See
+ ; line-indent, line-content, line-comment and the other
+ ; line-functions for details.
+ ; textlines : split-wisp-lines text
+ ; lines : linestoindented textlines
+ (lisp (wisp2lisp text)))
+ (display lisp)
+ (newline))
+ #f)
+
+
diff --git a/docs/srfi-119/wisp-guile.w b/docs/srfi-119/wisp-guile.w
new file mode 100755
--- /dev/null
+++ b/docs/srfi-119/wisp-guile.w
@@ -0,0 +1,833 @@
+#!/home/arne/wisp/wisp-multiline.sh
+; !#
+
+;; This file might need to be licensed permissively for inclusion in
+;; an SRFI. Only change it, if you agree to this possible relicensing
+;; of your contribution to this file. I will not accept changes here
+;; which do not allow that.
+
+; we need to be able to replace end-of-line characters in brackets and strings
+
+;; TODO: Check whether I can offload the string processing to the
+;; read-function. That’s a source of endless complications. Required:
+;; A kind of unrolling step which appends the string-representation of
+;; the read strings back into the code. I would have to process a list
+;; of strings instead of one big string. Or rather, each line would be
+;; a list of strings.
+
+;; bootstrap via python3 wisp.py wisp-guile.w > 1 && guile 1 wisp-guile.w > 2 && guile 2 wisp-guile.w > 3 && diff 2 3
+;;
+;; -Author: Arne Babenhauserheide
+
+;; Copyright (C) Arne Babenhauserheide (2013--2015). All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+
+define-module : wisp
+ . #:export : wisp2lisp wisp-chunkreader
+
+use-modules
+ : srfi srfi-1
+ : ice-9 regex
+
+define : endsinunevenbackslashes text ; comment
+ if : = 0 : string-length text
+ . #f
+ let counter
+ : last : string-take-right text 1
+ rest : string-append " " : string-drop-right text 1
+ count 0
+ cond
+ : = 0 : string-length rest ; end clause: read all
+ odd? count
+ ; end clause: no \
+ : not : equal? last : string #\\
+ odd? count
+ else
+ counter (string-take-right rest 1) (string-drop-right rest 1) (+ 1 count)
+
+
+define : nostringandbracketbreaks inport
+ . "Replace all linebreaks inside strings and brackets with placeholders."
+ let : : expressions : list : nostringandbracketbreaksreader inport
+ while : not : eof-object? : peek-char inport
+ set! expressions : append expressions : list : nostringandbracketbreaksreader inport
+ string-join expressions "\n"
+
+
+define : nostringandbracketbreaksreader inport
+ . "Read one wisp-expression from the inport.
+Ends with three consecutive linebreaks or eof."
+ ; Replace end of line characters in brackets and strings
+ ; FIXME: Breaks if the string is shorter than 2 chars
+ ; FIXME: Breaks if the text begins with a comment.
+ let*
+__ : lastchar : read-char inport
+____ nextchar : read-char inport
+____ text : if (eof-object? lastchar) "" : string lastchar
+ incomment #f
+ incommentfirstchar #f ; first char of a comment
+ instring #f
+ inbrackets 0
+ incharform 0 ; #\<something>
+ while
+ not
+ or : eof-object? nextchar
+ and
+ or (char=? nextchar #\newline ) (char=? nextchar #\return )
+ or (char=? lastchar #\newline ) (char=? lastchar #\return )
+ string-suffix? "\n\n" text ; text includes lastchar
+ ; incommentfirstchar is only valid for exactly one char
+ when incommentfirstchar : set! incommentfirstchar #f
+ ; but add incommentfirstchar if we just started the text
+ when : equal? text ";" ; initial comment
+ set! incommentfirstchar #f
+ set! incomment #t
+ set! text : string-append text "\\REALCOMMENTHERE"
+ ; already started char forms win over everything, so process them first.
+ ; already started means: after the #\
+ ; FIXME: Fails to capture #t and #f which can kill line splitting if it happens inside brackets
+ when : = incharform 1
+ when : not : and (char=? lastchar #\# ) : or (char=? #\f nextchar) (char=? #\t nextchar)
+ ; format #t "1: set incharform 0: lastchar ~a nextchar ~a instring ~a incomment ~a incharform ~a" lastchar nextchar instring incomment incharform
+ ; newline
+ set! incharform 0
+
+ when : >= incharform 2
+ if : or (char=? nextchar #\space) (char=?
+ nextchar #\newline ) (char=? nextchar #\return )
+ begin
+ ; format #t "2: set incharform 0: lastchar ~a nextchar ~a instring ~a incomment ~a incharform ~a" lastchar nextchar instring incomment incharform
+ ; newline
+ set! incharform 0
+ ; else
+ set! incharform : + incharform 1
+ ; check if we switch to a string: last char is space, linebreak or in a string, not in a charform, not in a comment
+ when
+ and
+ char=? nextchar #\"
+ not incomment
+ < incharform 1
+ or
+ and
+ . instring ; when I’m in a string, I can get out
+ or
+ not : char=? lastchar #\\ ; if the last char is not a backslash (escaped quote)
+ ; or the last char is a backslash preceded by an uneven number of backslashes (so the backslash is actually an escaped backslash)
+ and : char=? lastchar #\\
+ ; not : equal? #f : string-match "\\([^\\]\\)+\\(\\\\\\\\\\)*[\\]$" text ; matches [^\](\\)*\$ - non-backslash + arbitrary number of pairs of backslashes + final backslash which undoes the escaping from the lastchar (by actually escaping the lastchar)
+ endsinunevenbackslashes text
+ char=? lastchar #\space ; when the last char was a space, I can get into a string
+ char=? lastchar #\newline ; same for newline chars
+ char=? lastchar #\return
+ and : not instring ; outside of strings, brackets are pseudo-whitespace, too
+ or
+ char=? lastchar #\(
+ char=? lastchar #\)
+ char=? lastchar #\[
+ char=? lastchar #\]
+ ; TODO: Only match for braces {} if curly infix is enabled
+ char=? lastchar #\{
+ char=? lastchar #\}
+ set! instring : not instring
+ ; check if we switch to a comment
+ when
+ and
+ ; FIXME: this should be
+ ; char=? nextchar #\;
+ equal? ";" : string nextchar
+ not incomment
+ not instring
+ < incharform 2
+ set! incomment #t
+ set! incommentfirstchar #t
+ ; this also closes any potential charform
+ set! incharform 0
+ when
+ and incomment
+ or
+ char=? nextchar #\return
+ char=? nextchar #\newline
+ set! incomment #f
+
+ ; check for the beginning of a charform
+ when
+ and
+ not instring
+ not incomment
+ char=? lastchar #\space
+ char=? nextchar #\#
+ set! incharform 1
+ ; check whether a charform is continued
+ when
+ and
+ = incharform 1
+ char=? lastchar #\#
+ char=? nextchar #\\
+ set! incharform 2
+
+ ; check for brackets
+ ; FIXME: This only fixes a single linebreak inside parens, but if a second occurs on the same line it breaks. I do not know why. Maybe something with having lastchar as linebreak.
+ when : not : or instring incomment
+ when
+ and
+ not : string-suffix? text "#"
+ not : char=? #\\ lastchar
+ not : endsinunevenbackslashes : string-drop-right text : min 1 : string-length text
+ ; TODO: Only match for braces {} if curly infix is enabled
+ ; FIXME: Catch wrong ordering of parens/brackets/braces like ({)}
+ when : or (equal? "[" (string nextchar)) (equal? "(" (string nextchar)) (equal? "{" (string nextchar))
+ set! inbrackets : + inbrackets 1
+ when : or (equal? "}" (string nextchar)) (equal? ")" (string nextchar)) (equal? "]" (string nextchar))
+ set! inbrackets : - inbrackets 1
+ if : or instring : > inbrackets 0
+ if : char=? nextchar #\newline
+ ; we have to actually construct the escape
+ ; sequence here to be able to parse ourselves.
+ set! text : string-append text : string-append "\\LINE_" "BREAK_N"
+ if : char=? nextchar #\return
+ set! text : string-append text : string-append "\\LINE_" "BREAK_R"
+ ; else
+ set! text : string-append text : string nextchar
+ ; mark the start of a comment, so we do not have to
+ ; repeat the string matching in later code. We include
+ ; the comment character!
+ ; not (instring or inbrackets) = neither instring nor inbrackets
+ if incommentfirstchar
+ set! text : string-append text ( string nextchar ) "\\REALCOMMENTHERE"
+ ; when not in brackets or string or starting a
+ ; comment: just append the char
+ set! text : string-append text : string nextchar
+
+ set! lastchar nextchar
+ set! nextchar : read-char inport
+ ; return the text
+ . text
+
+
+; As next part we have split a text into a list of lines which we can process one by one.
+define : splitlines inport
+ let
+ : lines '()
+ nextchar : read-char inport
+ nextline ""
+ while : not : eof-object? nextchar
+ if : not : or (char=? nextchar #\return ) (char=? nextchar #\newline )
+ set! nextline : string-append nextline : string nextchar
+ begin
+ set! lines : append lines (list nextline)
+ set! nextline ""
+ set! nextchar : read-char inport
+ append lines : list nextline
+
+define : line-indent line
+ list-ref line 0
+
+define : line-content line
+ list-ref line 1
+
+define : line-comment line
+ list-ref line 2
+
+define : line-continues? line
+ . "Check whether the line is a continuation of a previous line (should not start with a bracket)."
+ if : equal? #f : line-content line
+ . #f ; this is the EOF line. It does not continue (to ensure that the last brackets get closed)
+ string-prefix? ". " : line-content line
+
+define : line-empty-code? line
+ . "Check whether the code-part of the line is empty: contains only whitespace and/or comment."
+ equal? "" : line-content line
+
+define : line-only-colon? line
+ . "Check whether the line content consists only of a colon and whitespace."
+ equal? ":" : string-trim-right : line-content line
+
+define : line-only-prefix? line prefix
+ . "Check whether the line content consists only of a given prefix and whitespace."
+ equal? prefix : string-trim-right : line-content line
+
+define : line-merge-comment line
+ . "Merge comment and content into the content. Return the new line."
+ let
+ : indent : line-indent line
+ content : line-content line
+ comment : line-comment line
+ if : equal? "" comment
+ . line ; no change needed
+ list indent : string-append content ";" comment
+ . ""
+
+
+; skip the leading indentation
+define : skipindent inport
+ let skipper
+ : inunderbars #t
+ indent 0
+ nextchar : read-char inport
+ ; when the file ends, do not do anything else
+ if : not : eof-object? nextchar
+ ; skip underbars
+ if inunderbars
+ if : char=? nextchar #\_ ; still in underbars?
+ skipper
+ . #t ; still in underbars?
+ + indent 1
+ read-char inport
+ ; else, reevaluate without inunderbars
+ skipper #f indent nextchar
+ ; else: skip remaining spaces
+ if : char=? nextchar #\space
+ skipper
+ . #f
+ + indent 1
+ read-char inport
+ begin
+ unread-char nextchar inport
+ . indent
+ . indent
+
+
+; Now we have to split a single line into indentation, content and comment.
+define : splitindent inport
+ let
+ : indent : skipindent inport
+ let
+ : nextchar : read-char inport
+ inindent #t ; it always begins in indent
+ incomment #f ; but not in a comment
+ commentstart #f
+ commentstartidentifier "\\REALCOMMENTHERE"
+ commentstartidentifierlength 16
+ commentidentifierindex 0
+ content ""
+ comment ""
+ while : not : eof-object? nextchar
+ ; check whether we leave the content
+ ; FIXME: (wisp.py) the reader cuts the ; here, when I write it as this:
+ ; when : and ( not incomment ) : char=? nextchar #\;
+ ; FIXME: THIS mistreats #\; as comment! (shown 4 lines after this comment…)
+ when
+ and
+ not incomment
+ ; FIXME: this should be but would break
+ ; char=? nextchar #\;
+ equal? ";" : string nextchar
+ not : string-suffix? ( string #\# #\\ ) content
+ set! commentstart #t
+ set! comment : string-append comment : string nextchar
+ set! nextchar : read-char inport
+ continue
+ ; check whether we stay in the commentcheck
+ when : and commentstart : char=? nextchar : string-ref commentstartidentifier commentidentifierindex
+
+ set! commentidentifierindex : + commentidentifierindex 1
+ set! comment : string-append comment : string nextchar
+ when : = commentidentifierindex commentstartidentifierlength
+ set! commentstart #f
+ set! incomment #t
+ ; reset used variables
+ set! commentidentifierindex 0
+ set! comment ""
+ set! nextchar : read-char inport
+ continue
+ ; if we cannot complete the commentcheck, we did not start a real comment. Append it to the content
+ when : and commentstart : not : char=? nextchar : string-ref commentstartidentifier commentidentifierindex
+ set! commentstart #f
+ set! content : string-append content comment : string nextchar
+ set! comment ""
+ set! commentidentifierindex 0
+ set! nextchar : read-char inport
+ continue
+ ; if we are in the comment, just append to the comment
+ when incomment
+ set! comment : string-append comment : string nextchar
+ set! nextchar : read-char inport
+ continue
+ ; if nothing else is true, we are in the content
+ set! content : string-append content : string nextchar
+ set! nextchar : read-char inport
+ when commentstart
+ set! content : string-append content comment
+ set! comment ""
+ ; return the indentation, the content and the comment
+ list indent content comment
+
+
+; Now use the function to split a list of lines
+define : linestoindented lines
+ let splitter
+ : unprocessed lines
+ processed '()
+ if : equal? unprocessed '()
+ . processed
+ ; else: let-recursion
+ splitter
+ list-tail unprocessed 1
+ append processed
+ list
+ call-with-input-string
+ list-ref unprocessed 0
+ . splitindent
+
+
+define : read-whole-file filename
+ let : : origfile : open-file filename "r"
+ let reader
+ : text ""
+ nextchar : read-char origfile
+ if : eof-object? nextchar
+ . text
+ reader
+ string-append text : string nextchar
+ read-char origfile
+
+
+
+define : wisp2lisp-add-inline-colon-brackets line
+ . "Add inline colon brackets to a wisp-line (indent,content,comment).
+
+A line with only a colon and whitespace gets no additional parens!
+
+Also unescape \\: to :.
+"
+ ; if the line only consists of a colon and whitespace, do not change it.
+ if : line-only-colon? line
+ . line
+ let : : content : line-content line
+ ; replace final " :" by a function call. There we are by definition of the line-splitting not in a string.
+ when : string-suffix? " :" content
+ set! content : string-append (string-drop-right content 1) "()"
+ ; process the content in reverse direction, so we can detect ' : and turn it into '(
+ ; let linebracketizer ( ( instring #f ) ( inbrackets 0 ) ( bracketstoadd 0 ) ( unprocessed content ) ( processed "" ) )
+ let linebracketizer : ( instring #f ) ( inbrackets 0 ) ( bracketstoadd 0 ) ( unprocessed content ) ( processed "" )
+ if : < (string-length unprocessed) 2
+ ; if unprocessed is < 2 chars, it cannot contain ": ". We are done.
+ list
+ line-indent line
+ string-append unprocessed processed : xsubstring ")" 0 bracketstoadd
+ line-comment line
+ ; else
+ let
+ : lastletter : string-take-right unprocessed 1
+ lastupto3 : string-take-right unprocessed : min 3 : string-length unprocessed
+ lastupto4 : string-take-right unprocessed : min 4 : string-length unprocessed
+ lastupto6 : string-take-right unprocessed : min 6 : string-length unprocessed
+ ; check if we’re in a string
+ when
+ or
+ and
+ not instring
+ equal? "\"" lastletter
+ not : equal? "#\\\"" lastupto3
+ and
+ . instring
+ equal? "\"" lastletter
+ not : endsinunevenbackslashes : string-drop-right unprocessed 1
+ set! instring : not instring
+ when : not instring
+ when
+ or
+ ; TODO: Only match for braces {} if curly infix is enabled
+ ; FIXME: Catch wrong ordering of parens/brackets/braces like ({)}
+ and (equal? "{" lastletter) : not : equal? "#\\{" lastupto3
+ and (equal? "[" lastletter) : not : equal? "#\\[" lastupto3
+ and (equal? "(" lastletter) : not : equal? "#\\(" lastupto3
+ set! inbrackets : - inbrackets 1
+ when
+ or
+ and (equal? ")" lastletter) : not : equal? "#\\)" lastupto3
+ and (equal? "]" lastletter) : not : equal? "#\\]" lastupto3
+ and (equal? "}" lastletter) : not : equal? "#\\}" lastupto3
+ set! inbrackets : + 1 inbrackets ; remember that we're going backwards!
+ ; error handling: inbrackets must never be smaller than 0 - due to the line splitting.
+ when : < inbrackets 0
+ throw 'more-inline-brackets-closed-than-opened inbrackets line
+ ; when we’re in a string or in brackets , just skip to the next char
+ cond
+ : or instring : > inbrackets 0
+ linebracketizer instring inbrackets bracketstoadd
+ . : string-drop-right unprocessed 1
+ . : string-append lastletter processed
+ ; else check for " : ": That adds a new inline bracket
+ ; support : at the beginning of a line, too.
+ : or (equal? " : " lastupto3) (equal? ": " lastupto3)
+ ; replace the last 2 chars with "(" and note
+ ; that we need an additional closing bracket
+ ; at the end.
+ linebracketizer instring inbrackets : + 1 bracketstoadd
+ string-append (string-drop-right unprocessed 2)
+ string-append "(" processed
+ ; turn " ' (" into " '(", do not modify unprocessed, except to shorten it!
+ ; same for ` , #' #` #, #,@,
+ : and (string-prefix? "(" processed) : equal? " ' " lastupto3
+ ; leave out the second space
+ linebracketizer instring inbrackets bracketstoadd
+ . (string-append (string-drop-right unprocessed 2) "'")
+ . processed
+ : and (string-prefix? "(" processed) : equal? " , " lastupto3
+ ; leave out the second space
+ linebracketizer instring inbrackets bracketstoadd
+ . (string-append (string-drop-right unprocessed 2) ",")
+ . processed
+ : and (string-prefix? "(" processed) : equal? " ` " lastupto3
+ ; leave out the second space
+ linebracketizer instring inbrackets bracketstoadd
+ . (string-append (string-drop-right unprocessed 2) "`")
+ . processed
+ : and (string-prefix? "(" processed) : equal? " #` " lastupto4
+ ; leave out the second space
+ linebracketizer instring inbrackets bracketstoadd
+ . (string-append (string-drop-right unprocessed 3) "#`")
+ . processed
+ : and (string-prefix? "(" processed) : equal? " #' " lastupto4
+ ; leave out the second space
+ linebracketizer instring inbrackets bracketstoadd
+ . (string-append (string-drop-right unprocessed 3) "#'")
+ . processed
+ : and (string-prefix? "(" processed) : equal? " #, " lastupto4
+ ; leave out the second space
+ linebracketizer instring inbrackets bracketstoadd
+ . (string-append (string-drop-right unprocessed 3) "#,")
+ . processed
+ : and (string-prefix? "(" processed) : equal? " #,@, " lastupto6
+ ; leave out the second space
+ linebracketizer instring inbrackets bracketstoadd
+ . (string-append (string-drop-right unprocessed 5) "#,@,")
+ . processed
+ else ; just go on
+ linebracketizer instring inbrackets bracketstoadd
+ . (string-drop-right unprocessed 1)
+ . (string-append lastletter processed)
+
+
+define : last-indent levels
+ . "Retrieve the indentation of the last line: Simply the highest level."
+ list-ref levels 0
+
+define : line-add-starting-bracket line
+ . "Add a starting bracket to the line, if it is no continuation line (it is more indented than the previous).
+
+If line starts with one of ' , ` #` #' #, #,@, then turn it into '(... instead of ('...
+
+If line is indented and only contains : and optional whitespace, remove the :.
+
+The line *must* have a whitespace after the prefix, except if the prefix is the only non-whitespace on the line."
+ ; if the line only contains a colon, we just replace its content with an opening paren.
+ if : line-only-colon? line ; FIXME: Check for this somewhere else.
+ list
+ line-indent line
+ string-append "(" : string-drop (line-content line) 1 ; keep whitespace
+ line-comment line
+ let loop : : paren-prefixes : list "' " ", " "` " "#` " "#' " "#, " "#,@, "
+ ; first check whether we are done checking
+ if : null-list? paren-prefixes
+ ; construct the line structure: '(indentation-depth content comment)
+ list
+ line-indent line
+ string-append
+ . "("
+ line-content line
+ line-comment line
+ ; otherwise check all possible prefixes
+ let*
+ : prefix : car paren-prefixes
+ prefix-no-space : string-drop-right prefix 1
+ cond
+ : string-prefix? prefix : line-content line
+ list
+ line-indent line
+ string-append
+ . prefix-no-space "("
+ string-drop (line-content line) : string-length prefix
+ line-comment line
+ : line-only-prefix? line prefix-no-space
+ list
+ line-indent line
+ string-append
+ . (string-drop-right prefix 1) "("
+ string-drop (line-content line) : string-length prefix-no-space
+ line-comment line
+ else
+ loop : cdr paren-prefixes
+
+define : line-add-closing-brackets line number
+ . "Add a closing bracket to the line."
+ list
+ line-indent line
+ string-append
+ line-content line
+ xsubstring ")" 0 number
+ line-comment line
+
+define : line-indent-brackets-to-close line-indent levels line-continues prev-continues
+ . "Find the number of brackets to close to reduce the levels to the line-indent."
+ ; adjust the levels until the highest indentation level is equal
+ ; to the indentation of the next line. Then check for
+ ; continuation.
+ let closer : (bracketstoclose 0) (rest levels)
+ let : : highest-level : list-ref rest 0
+ ; finish-condition
+ if : = line-indent highest-level
+ if prev-continues
+ . bracketstoclose
+ + 1 bracketstoclose
+ if : > line-indent highest-level
+ closer (- bracketstoclose 1) : append (list line-indent) rest
+ closer (+ bracketstoclose 1) : list-tail rest 1
+
+
+define : line-indent-brackets-to-open line-indent levels line-continues prev-continues
+ . "Find the number of brackets to open to fit the line-indent and continuation marker."
+ if line-continues
+ . 0
+ . 1
+
+define : line-indent-levels-adjust levels next-indent
+ . "Add or remove levels so the highest remaining level matches next-indent."
+ let adjuster : (lev levels)
+ let : : highest-level : list-ref lev 0
+ if : = next-indent highest-level
+ . lev
+ if : > next-indent highest-level
+ append (list next-indent) lev
+ adjuster : list-tail lev 1
+
+define : line-drop-continuation-dot line
+ let : : content : line-content line
+ list
+ line-indent line
+ if : line-continues? line
+ string-drop content 2
+ . content
+ line-comment line
+
+define : wisp2lisp-parse lisp prev lines
+ . "Parse the body of the wisp-code."
+ set! prev : wisp2lisp-add-inline-colon-brackets prev ; prev already is a code-line.
+ if : not : or (line-continues? prev) (line-empty-code? prev)
+ set! prev : line-add-starting-bracket prev
+ set! lines : map-in-order wisp2lisp-add-inline-colon-brackets lines
+ let bracketizer : (levels '(0)) (pre prev) (unprocessed lines) (processed lisp) (whitespace '())
+ ; levels is the list of levels, with the lowest to the right. i.e: '(12 8 4 0)
+ ; once we processed everything, we pass the bracketizer pre as f one last time
+ if : equal? #f : line-content pre
+ . processed
+ let : : next : if (equal? unprocessed '()) (list 0 #f #f) : list-ref unprocessed 0 ; this is the break condition for the next loop!
+ if : line-empty-code? next ; empty lines get silently added, but otherwise ignored
+ bracketizer levels pre
+ list-tail unprocessed 1
+ . processed
+ append whitespace : list next
+ ; firstoff add the next indent to the levels, so we only work on the levels, prev-continues, next-continues and next-indent
+ ; if pre was a continuation, the real levels are 1 lower than the counted levels
+ let*
+ : next-indent : line-indent next
+ pre-indent : line-indent pre
+ pre-continues : line-continues? pre
+ next-continues : line-continues? next
+ final-line : equal? #f : line-content next
+ bracketstocloseprev : if (line-empty-code? pre) 0 : line-indent-brackets-to-close next-indent levels next-continues pre-continues
+ bracketstoopennext : line-indent-brackets-to-open next-indent levels next-continues pre-continues
+ newnext : if final-line next : if (> bracketstoopennext 0) (line-add-starting-bracket next) next
+ newpre : line-drop-continuation-dot : line-add-closing-brackets pre bracketstocloseprev
+ newlevels : line-indent-levels-adjust levels next-indent
+ bracketizer newlevels newnext
+ if final-line unprocessed : list-tail unprocessed 1
+ append processed (list newpre) whitespace
+ list
+
+
+define : wisp2lisp-initial-comments lisp prev lines
+ . "Keep all starting comments: do not start them with a bracket."
+ let skip-initial-comments : (lisp lisp) (prev prev) (lines lines)
+ if : = 0 : length lines ; file only contained comments, maybe including the hashbang
+ list lisp prev lines
+ if : line-empty-code? prev
+ skip-initial-comments : append lisp : list prev
+ . (list-ref lines 0) (list-tail lines 1)
+ list lisp prev lines
+
+define : wisp2lisp-hashbang lisp prev unprocessed
+ . "Parse a potential initial hashbang line."
+ if
+ and
+ equal? lisp '() ; really the first line
+ equal? 0 : line-indent prev
+ string-prefix? "#!" : line-content prev
+ wisp2lisp-hashbang : append lisp : list : line-merge-comment prev
+ . (list-ref unprocessed 0) (list-tail unprocessed 1)
+ list lisp prev unprocessed
+
+define : wisp2lisp-lines lines
+ . "Parse indentation in the lines to add the correct brackets."
+ if : equal? lines '()
+ . '()
+ let
+ : lisp '() ; the processed lines
+ prev : list-ref lines 0 ; the last line
+ unprocessed : list-tail lines 1 ; obvious :)
+ let*
+ : hashbanged : wisp2lisp-hashbang lisp prev unprocessed
+ deinitialized : apply wisp2lisp-initial-comments hashbanged
+ parsed : apply wisp2lisp-parse deinitialized
+ . parsed
+
+define : line-unescape-underscore-and-colon line
+ . "Unescape underscores at the beginning of the line and colon."
+ let loop
+ : processed ""
+ unprocessed : line-content line
+ if : equal? "" unprocessed
+ list
+ line-indent line
+ . processed
+ line-comment line
+ let
+ : next : string : string-ref unprocessed 0
+ if : equal? "" processed
+ cond
+ ; get rid of \_
+ : string-prefix? "(\\_" unprocessed
+ loop processed : string-append "(" : string-drop unprocessed 2
+ ; get rid of \:
+ : string-prefix? "(\\:" unprocessed
+ loop processed : string-append "(" : string-drop unprocessed 2
+ ; get rid of . \:
+ : string-prefix? "\\:" unprocessed
+ loop processed : string-drop unprocessed 1
+ else
+ loop
+ string-append processed next
+ string-drop unprocessed 1
+ cond
+ : string-prefix? " \\:" unprocessed
+ loop
+ string-append processed " :"
+ string-drop unprocessed 3
+ : string-prefix? "(\\:" unprocessed
+ loop
+ string-append processed "(:"
+ string-drop unprocessed 3
+ else
+ loop
+ string-append processed next
+ string-drop unprocessed 1
+
+define : unescape-underscore-and-colon lines
+ . "Unescape underscores at the beginning of each line and colon."
+ let loop
+ : processed '()
+ unprocessed lines
+ if : equal? unprocessed '()
+ . processed
+ let : : current : car unprocessed
+ loop
+ append processed : list : line-unescape-underscore-and-colon current
+ cdr unprocessed
+
+
+
+define* : string-replace-substring s substr replacement #:optional (start 0) (end (string-length s))
+ . "Replace every instance of substring in s by replacement."
+ let : : substr-length : string-length substr
+ if : zero? substr-length
+ error "string-replace-substring: empty substr"
+ let loop
+ : start start
+ pieces : list : substring s 0 start
+ let : : idx : string-contains s substr start end
+ if idx
+ loop : + idx substr-length
+ cons* replacement
+ substring s start idx
+ . pieces
+ string-concatenate-reverse
+ cons : substring s start
+ . pieces
+
+
+define : unescape-linebreaks text
+ . "unescape linebreaks"
+ string-replace-substring
+ ; we have to construct the placeholders here to avoid unescaping them when we parse ourselves…
+ string-replace-substring text (string-append "\\LINE_" "BREAK_N") : string #\newline
+ string-append "\\LINE_" "BREAK_R"
+ string #\return
+
+
+define : unescape-comments text
+ . "unescape comments"
+ string-replace-substring text
+ ; we have to construct the placeholders here to avoid unescaping them when we parse ourselves…
+ string-append ";" "\\REALCOMMENTHERE"
+ . ";"
+
+
+define : wisp-chunkreader inport
+ . "Read one wisp-expression from inport, without escaping of fake newlines but with correct detection of real new lines.
+ Realized by reading with newline and comment escaping and unescaping both again after reading."
+ unescape-comments
+ unescape-linebreaks
+ nostringandbracketbreaksreader inport
+
+
+define : join-lisp-lines lisp-lines
+ let join : (joined "") (unprocessed lisp-lines)
+ if : not : equal? unprocessed '()
+ let*
+ : next : list-ref unprocessed 0
+ nextstring
+ string-append
+ xsubstring " " 0 : line-indent next
+ ; here we re-add all necessary linebreakswe get rid
+ unescape-linebreaks : line-content next
+ if : equal? "" : line-comment next
+ . ""
+ string-append ";" : line-comment next
+ . "\n"
+ join (string-append joined nextstring) (list-tail unprocessed 1)
+ . joined
+
+define : wisp2lisp text
+ let*
+ : nobreaks : call-with-input-string text nostringandbracketbreaks
+ textlines : call-with-input-string nobreaks splitlines
+ lines : linestoindented textlines
+ lisp-lines : wisp2lisp-lines lines
+ clean-lines : unescape-underscore-and-colon lisp-lines
+ join-lisp-lines clean-lines
+
+ ; first step: Be able to mirror a file to stdout
+if : < 1 : length : command-line
+ let*
+ : filename : list-ref ( command-line ) 1
+ text : read-whole-file filename
+ ; Lines consist of lines with indent, content and comment. See
+ ; line-indent, line-content, line-comment and the other
+ ; line-functions for details.
+ ; textlines : split-wisp-lines text
+ ; lines : linestoindented textlines
+ lisp : wisp2lisp text
+ display lisp
+ newline
+ . #f
diff --git a/docs/srfi-119/wisp-scheme.scm b/docs/srfi-119/wisp-scheme.scm
new file mode 100644
--- /dev/null
+++ b/docs/srfi-119/wisp-scheme.scm
@@ -0,0 +1,831 @@
+#!/bin/bash
+(# -*- wisp -*-)
+(exec guile -L . --language=wisp -s "$0" "$@")
+; !#
+
+;; Scheme-only implementation of a wisp-preprocessor which output a
+;; scheme code tree to feed to a scheme interpreter instead of a
+;; preprocessed file.
+
+;; Plan:
+;; read reads the first expression from a string. It ignores comments,
+;; so we have to treat these specially. Our wisp-reader only needs to
+;; worry about whitespace.
+;;
+;; So we can skip all the string and bracket linebreak escaping and
+;; directly create a list of codelines with indentation. For this we
+;; then simply reuse the appropriate function from the generic wisp
+;; preprocessor.
+
+;; Copyright (C) Arne Babenhauserheide (2014--2015). All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+
+(define-module (wisp-scheme)
+ #:export (wisp-scheme-read-chunk wisp-scheme-read-all
+ wisp-scheme-read-file-chunk wisp-scheme-read-file
+ wisp-scheme-read-string))
+
+; use curly-infix by default
+(read-enable 'curly-infix)
+
+(use-modules
+ (srfi srfi-1)
+ (srfi srfi-11 ); for let-values
+ (ice-9 rw ); for write-string/partial
+ (ice-9 match))
+
+;; Helper functions for the indent-and-symbols data structure: '((indent token token ...) ...)
+(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 (= -1 indent)
+ 0
+ indent)))
+
+(define (line-code line)
+ (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 the 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.
+ ; TODO: Somehow store source-properties. The commented-out code below does not work.
+ ; catch #t
+ ; lambda ()
+ ; write : source-properties symbol-or-symbols
+ ; set-source-property! symbol-or-symbols 'filename : port-filename port
+ ; set-source-property! symbol-or-symbols 'line : 1+ : port-line port
+ ; set-source-property! symbol-or-symbols 'column : port-column port
+ ; write : source-properties symbol-or-symbols
+ ; lambda : key . arguments
+ ; . #f
+ 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 empty.
+ (= 0 (line-indent line))
+ (line-empty-code? line)))
+
+(define (line-strip-continuation line )
+ (if (line-continues? line)
+ (append
+ (list
+ (line-indent line))
+ (cdr (line-code line)))
+ line))
+
+(define (line-strip-indentation-marker line)
+ "Strip the indentation markers from the beginning of the line"
+ (cdr line))
+
+(define (indent-level-reduction indentation-levels level select-fun)
+ "Reduce the INDENTATION-LEVELS to the given LEVEL and return the value selected by SELECT-FUN"
+ (let loop
+ ((newlevels indentation-levels)
+ (diff 0))
+ (cond
+ ((= level (car newlevels))
+ (select-fun (list diff indentation-levels)))
+ ((< level (car newlevels))
+ (loop
+ (cdr newlevels)
+ (1+ diff)))
+ (else
+ (throw 'wisp-syntax-error "Level ~A not found in the indentation-levels ~A.")))))
+
+(define (indent-level-difference indentation-levels level)
+ "Find how many indentation levels need to be popped off to find the given 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 given level."
+ (indent-level-reduction indentation-levels level
+ (lambda (x ); get the levels
+ (car (cdr x)))))
+
+
+(define (wisp-scheme-read-chunk-lines port)
+ (let loop
+ ((indent-and-symbols (list )); '((5 "(foobar)" "\"yobble\"")(3 "#t"))
+ (inindent #t)
+ (inunderscoreindent (equal? #\_ (peek-char port)))
+ (incomment #f)
+ (currentindent 0)
+ (currentsymbols '())
+ (emptylines 0))
+ (cond
+ ((>= 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 (append (list currentindent) currentsymbols))))
+ ((and inindent (zero? currentindent) (not incomment) (not (null? indent-and-symbols)) (not inunderscoreindent) (not (or (equal? #\space next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) next-char))))
+ (append indent-and-symbols )); top-level form ends chunk
+ ((and inindent (equal? #\space next-char))
+ (read-char port ); remove char
+ (loop
+ indent-and-symbols
+ #t ; inindent
+ #f ; inunderscoreindent
+ #f ; incomment
+ (1+ currentindent)
+ currentsymbols
+ emptylines))
+ ((and inunderscoreindent (equal? #\_ next-char))
+ (read-char port ); remove char
+ (loop
+ indent-and-symbols
+ #t ; inindent
+ #t ; inunderscoreindent
+ #f ; incomment
+ (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 empty lines.
+ ((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)))
+ ((equal? #\newline next-char)
+ (read-char port ); remove the newline
+ ; The following two lines would break the REPL by requiring one char too many.
+ ; if : and (equal? #\newline next-char) : equal? #\return : peek-char port
+ ; read-char port ; remove a full \n\r. Damn special cases...
+ (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
+ (incomment
+ (if (= 0 currentindent ); specialcase
+ -1
+ currentindent ))
+ ((not (null? currentsymbols )); pure whitespace
+ currentindent)
+ (else
+ 0)))
+ (parsedline (append (list indent) currentsymbols))
+ (emptylines
+ (if (not (line-empty? parsedline))
+ 0
+ (1+ emptylines))))
+ (when (not (= 0 (length parsedline)))
+ ; set the source properties to parsedline so we can try to add them later.
+ (set-source-property! parsedline 'filename (port-filename port))
+ (set-source-property! parsedline 'line (port-line port)))
+ ; TODO: If the line is empty. Either do it here and do not add it, just
+ ; increment the empty line counter, or strip it later. Replace indent
+ ; -1 by indent 0 afterwards.
+ (loop
+ (append indent-and-symbols (list parsedline))
+ #t ; inindent
+ (if (<= 2 emptylines)
+ #f ; chunk ends here
+ (equal? #\_ (peek-char port ))); are we in underscore indent?
+ #f ; incomment
+ 0
+ '()
+ emptylines)))
+ ((equal? #t incomment)
+ (read-char port ); remove one comment character
+ (loop
+ indent-and-symbols
+ #f ; inindent
+ #f ; inunderscoreindent
+ #t ; incomment
+ 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 ; inindent
+ #f ; inunderscoreindent
+ #f ; incomment
+ currentindent
+ currentsymbols
+ emptylines))
+ ; | cludge to appease the former wisp parser
+ ; | which had a problem with the literal comment
+ ; v char.
+ ((equal? (string-ref ";" 0) next-char)
+ (loop
+ indent-and-symbols
+ #f ; inindent
+ #f ; inunderscoreindent
+ #t ; incomment
+ currentindent
+ currentsymbols
+ emptylines))
+ (else ; use the reader
+ (loop
+ indent-and-symbols
+ #f ; inindent
+ #f ; inunderscoreindent
+ #f ; incomment
+ currentindent
+ ; this also takes care of the hashbang and leading comments.
+ ; TODO: If used from Guile, activate curly infix via read-options.
+ (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 line"
+ ; 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)
+ ((equal? readcolon (car unprocessed))
+ (loop
+ ; FIXME: This should turn unprocessed into a list.
+ (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. We need to kill the colon before replacing inline colons."
+ (if
+ (equal?
+ (line-code line)
+ (list readcolon))
+ (list (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 target."
+ (catch #t
+ (lambda ()
+ (set-source-properties! target (source-properties source)))
+ (lambda (key . arguments)
+ #f))
+ target)
+
+(define (wisp-propagate-source-properties code)
+ "Propagate the source properties from the sourrounding list into every part of the code."
+ (let loop
+ ((processed '())
+ (unprocessed code))
+ (cond
+ ((and (null? processed) (not (pair? unprocessed)) (not (list? unprocessed)))
+ 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)))))))
+
+(define (wisp-scheme-indentation-to-parens lines)
+ "Add parentheses to lines and remove the indentation markers"
+ ; FIXME: Find new algorithm which mostly uses current-line
+ ; and the indentation-levels for tracking. The try I have in
+ ; here right now is wrong.
+ (when
+ (and
+ (not (null? lines))
+ (not (line-empty-code? (car lines)))
+ (not (= 0 (line-real-indent (car lines ))))); -1 is a line with a comment
+ (throw 'wisp-syntax-error
+ (format #f "The first symbol in a chunk must start at zero indentation. Indentation and line: ~A"
+ (car lines))))
+ (let loop
+ ((processed '())
+ (unprocessed lines)
+ (indentation-levels '(0)))
+ (let*
+ (
+ (current-line
+ (if (<= 1 (length unprocessed))
+ (car unprocessed)
+ (list 0 ))); empty code
+ (next-line
+ (if (<= 2 (length unprocessed))
+ (car (cdr unprocessed))
+ (list 0 ))); empty code
+ (current-indentation
+ (car indentation-levels))
+ (current-line-indentation (line-real-indent current-line)))
+ ; format #t "processed: ~A\ncurrent-line: ~A\nnext-line: ~A\nunprocessed: ~A\nindentation-levels: ~A\ncurrent-indentation: ~A\n\n"
+ ; . processed current-line next-line unprocessed indentation-levels current-indentation
+ (cond
+ ; the real end: this is reported to the outside world.
+ ((and (null? unprocessed) (not (null? indentation-levels)) (null? (cdr indentation-levels)))
+ ; display "done\n"
+ ; reverse the processed lines, because I use cons.
+ processed)
+ ; the recursion end-condition
+ ((and (null? unprocessed))
+ ; display "last step\n"
+ ; 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)
+ ; display "indentation-levels null\n"
+ (throw 'wisp-programming-error "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-counting.
+ (cond
+ ((line-empty-code? current-line)
+ ; display "current-line empty\n"
+ ; We cannot process indentation without
+ ; code. Just switch to the next line. This should
+ ; only happen at the start of the recursion.
+ ; TODO: Somehow preserve the line-numbers.
+ (loop
+ processed
+ (cdr unprocessed)
+ indentation-levels))
+ ((and (line-empty-code? next-line) (<= 2 (length unprocessed )))
+ ; display "next-line empty\n"
+ ; TODO: Somehow preserve the line-numbers.
+ ; take out the next-line from unprocessed.
+ (loop
+ processed
+ (cons current-line
+ (cdr (cdr unprocessed)))
+ indentation-levels))
+ ((> current-indentation current-line-indentation)
+ ; display "current-indent > next-line\n"
+ ; this just steps back one level via the side-recursion.
+ (values processed unprocessed))
+ ((= current-indentation current-line-indentation)
+ ; display "current-indent = next-line\n"
+ (let
+ ((line (line-finalize current-line))
+ (next-line-indentation (line-real-indent next-line)))
+ (cond
+ ((>= current-line-indentation next-line-indentation)
+ ; simple recursiive step to the next line
+ ; display "current-line-indent >= next-line-indent\n"
+ (loop
+ (append processed
+ (if (line-continues? current-line)
+ line
+ (wisp-add-source-properties-from line (list line))))
+ (cdr unprocessed ); recursion here
+ indentation-levels))
+ ((< current-line-indentation next-line-indentation)
+ ; display "current-line-indent < next-line-indent\n"
+ ; format #t "line: ~A\n" line
+ ; side-recursion via a sublist
+ (let-values
+ (
+ ((sub-processed sub-unprocessed)
+ (loop
+ line
+ (cdr unprocessed ); recursion here
+ indentation-levels)))
+ ; format #t "side-recursion:\n sub-processed: ~A\n processed: ~A\n\n" sub-processed processed
+ (loop
+ (append processed (list sub-processed))
+ sub-unprocessed ; simply use the recursion from the sub-recursion
+ indentation-levels))))))
+ ((< current-indentation current-line-indentation)
+ ; display "current-indent < next-line\n"
+ (loop
+ processed
+ unprocessed
+ (cons ; recursion via the indentation-levels
+ current-line-indentation
+ indentation-levels)))
+ (else
+ (throw 'wisp-not-implemented
+ (format #f "Need to implement further line comparison: current: ~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 line"
+ (let loop
+ ((processed '())
+ (unprocessed lines))
+ (if (null? unprocessed)
+ processed
+ (loop
+ (append processed (list (line-replace-inline-colons (car unprocessed))))
+ (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 :"
+ (match code
+ ((a ...)
+ (map wisp-unescape-underscore-and-colon a))
+ ('\_
+ '_)
+ ('\:
+ ':)
+ (a
+ a)))
+
+
+(define (wisp-replace-empty-eof code)
+ "replace ((#<eof>)) by ()"
+ ; FIXME: Actually 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 code))) (null? (cdr code)) (null? (cdr (car code))))
+ (list)
+ code))
+
+
+(define (wisp-replace-paren-quotation-repr code)
+ "Replace lists starting with a quotation symbol by
+ quoted lists."
+ (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-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)))
+ ((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!"
+ (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)
+ (throw 'wisp-syntax-error (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 from wisp-scheme itself. Why?
+ (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd . c)
+ (syntax-error tocheck "dot as first element in already improper pair"))
+ ; simple pair, other way round
+ ((a . 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd)
+ (syntax-error tocheck "dot as last element in already improper pair"))
+ ; more complex pairs
+ ((? pair? a)
+ (let
+ ((head (drop-right a 1))
+ (tail (last-pair a)))
+ (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"
+ (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))
+
+
+;;;; Test special syntax
+; ;; quote the list
+; write
+; wisp-scheme-read-string "moo
+; foo
+; ' bar
+; baz waz"
+; newline
+; ;; quote the symbol - in wisp, whitespace after quote is not allowed!
+; write
+; wisp-scheme-read-string "moo
+; foo
+; 'bar
+; baz waz"
+; newline
+; ; ;; quote the list with colon
+; write
+; wisp-scheme-read-string "moo : ' foo
+; foo
+; ' bar bah
+; baz waz"
+; newline
+; ; ;; syntax the list
+; write
+; wisp-scheme-read-string "moo : #' foo
+; foo
+; #' bar bah
+; baz waz"
+; newline
+;
+;;;; Test improper lists
+;;;; Good cases
+; write
+; wisp-scheme-read-string "foo . bar"
+; newline
+; write
+; wisp-scheme-read-string "foo .
+; . bar"
+; newline
+; write
+; wisp-scheme-read-string "foo
+; . . bar"
+; newline
+; write
+; wisp-scheme-read-string "moo
+; foo
+; . . bar
+; baz waz"
+; newline
+;;;; Syntax Error cases
+; write
+; wisp-scheme-read-string "foo
+; . . ."
+; newline
+; write
+; wisp-scheme-read-string "moo : . . bar"
+; write
+; wisp-scheme-read-string "foo .
+; . . bar"
+; newline
+; write
+; wisp-scheme-read-string "moo
+; foo
+; . . bar baz
+; baz waz"
+; newline
+;;;; stranger stuff
+; write
+; wisp-scheme-read-string "foo ; bar\n ; nop \n\n; nup\n; nup \n \n\n\nfoo : moo \"\n\" \n___ . goo . hoo"
+; newline
+; display
+; wisp-scheme-read-string " foo ; bar\n ; nop \n\n; nup\n; nup \n \n\n\nfoo : moo"
+; newline
+; write : wisp-scheme-read-file-chunk "wisp-scheme.w"
+; newline
+; call-with-output-file "wisp-guile.scm"
+; lambda : port
+; map
+; lambda : chunk
+; write chunk port
+; wisp-scheme-read-file "wisp-guile.w"
+; run all chunks in wisp-guile.w as parsed by wisp-scheme.w. Give wisp-guile.w to parse as argument.
+; map primitive-eval : wisp-scheme-read-file "wisp-guile.w" ; actually runs wisp-guile.w with the arguments supplied to this script.
+; uncomment the previous line, then run the next line in the shell. If 1 and 2 are equal, this parser works!
+; guile wisp.scm wisp-scheme.w > wisp-scheme.scm; guile wisp-scheme.scm wisp-guile.w > 1; guile wisp.scm wisp-guile.w > 2; diff 1 2
+
+
+
diff --git a/docs/srfi-119/wisp-scheme.w b/docs/srfi-119/wisp-scheme.w
new file mode 100755
--- /dev/null
+++ b/docs/srfi-119/wisp-scheme.w
@@ -0,0 +1,829 @@
+#!/bin/bash
+# -*- wisp -*-
+exec guile -L . --language=wisp -s "$0" "$@"
+; !#
+
+;; Scheme-only implementation of a wisp-preprocessor which output a
+;; scheme code tree to feed to a scheme interpreter instead of a
+;; preprocessed file.
+
+;; Plan:
+;; read reads the first expression from a string. It ignores comments,
+;; so we have to treat these specially. Our wisp-reader only needs to
+;; worry about whitespace.
+;;
+;; So we can skip all the string and bracket linebreak escaping and
+;; directly create a list of codelines with indentation. For this we
+;; then simply reuse the appropriate function from the generic wisp
+;; preprocessor.
+
+;; Copyright (C) Arne Babenhauserheide (2014--2015). All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+
+define-module : wisp-scheme
+ . #:export (wisp-scheme-read-chunk wisp-scheme-read-all
+ wisp-scheme-read-file-chunk wisp-scheme-read-file
+ wisp-scheme-read-string)
+
+; use curly-infix by default
+read-enable 'curly-infix
+
+use-modules
+ srfi srfi-1
+ srfi srfi-11 ; for let-values
+ ice-9 rw ; for write-string/partial
+ ice-9 match
+
+;; Helper functions for the indent-and-symbols data structure: '((indent token token ...) ...)
+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 : = -1 indent
+ . 0
+ . indent
+
+define : line-code line
+ 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 the 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.
+ ; TODO: Somehow store source-properties. The commented-out code below does not work.
+ ; catch #t
+ ; lambda ()
+ ; write : source-properties symbol-or-symbols
+ ; set-source-property! symbol-or-symbols 'filename : port-filename port
+ ; set-source-property! symbol-or-symbols 'line : 1+ : port-line port
+ ; set-source-property! symbol-or-symbols 'column : port-column port
+ ; write : source-properties symbol-or-symbols
+ ; lambda : key . arguments
+ ; . #f
+ . 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 empty.
+ = 0 : line-indent line
+ line-empty-code? line
+
+define : line-strip-continuation line
+ if : line-continues? line
+ append
+ list
+ line-indent line
+ cdr : line-code line
+ . line
+
+define : line-strip-indentation-marker line
+ . "Strip the indentation markers from the beginning of the line"
+ cdr line
+
+define : indent-level-reduction indentation-levels level select-fun
+ . "Reduce the INDENTATION-LEVELS to the given LEVEL and return the value selected by SELECT-FUN"
+ let loop
+ : newlevels indentation-levels
+ diff 0
+ cond
+ : = level : car newlevels
+ select-fun : list diff indentation-levels
+ : < level : car newlevels
+ loop
+ cdr newlevels
+ 1+ diff
+ else
+ throw 'wisp-syntax-error "Level ~A not found in the indentation-levels ~A."
+
+define : indent-level-difference indentation-levels level
+ . "Find how many indentation levels need to be popped off to find the given 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 given level."
+ indent-level-reduction indentation-levels level
+ lambda : x ; get the levels
+ car : cdr x
+
+
+define : wisp-scheme-read-chunk-lines port
+ let loop
+ : indent-and-symbols : list ; '((5 "(foobar)" "\"yobble\"")(3 "#t"))
+ inindent #t
+ inunderscoreindent : equal? #\_ : peek-char port
+ incomment #f
+ currentindent 0
+ currentsymbols '()
+ emptylines 0
+ cond
+ : >= 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 : append (list currentindent) currentsymbols
+ : and inindent (zero? currentindent) (not incomment) (not (null? indent-and-symbols)) (not inunderscoreindent) (not (or (equal? #\space next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) next-char)))
+ append indent-and-symbols ; top-level form ends chunk
+ : and inindent : equal? #\space next-char
+ read-char port ; remove char
+ loop
+ . indent-and-symbols
+ . #t ; inindent
+ . #f ; inunderscoreindent
+ . #f ; incomment
+ 1+ currentindent
+ . currentsymbols
+ . emptylines
+ : and inunderscoreindent : equal? #\_ next-char
+ read-char port ; remove char
+ loop
+ . indent-and-symbols
+ . #t ; inindent
+ . #t ; inunderscoreindent
+ . #f ; incomment
+ 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 empty lines.
+ : 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
+ : equal? #\newline next-char
+ read-char port ; remove the newline
+ ; The following two lines would break the REPL by requiring one char too many.
+ ; if : and (equal? #\newline next-char) : equal? #\return : peek-char port
+ ; read-char port ; remove a full \n\r. Damn special cases...
+ 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
+ incomment
+ if : = 0 currentindent ; specialcase
+ . -1
+ . currentindent
+ : not : null? currentsymbols ; pure whitespace
+ . currentindent
+ else
+ . 0
+ parsedline : append (list indent) currentsymbols
+ emptylines
+ if : not : line-empty? parsedline
+ . 0
+ 1+ emptylines
+ when : not : = 0 : length parsedline
+ ; set the source properties to parsedline so we can try to add them later.
+ set-source-property! parsedline 'filename : port-filename port
+ set-source-property! parsedline 'line : port-line port
+ ; TODO: If the line is empty. Either do it here and do not add it, just
+ ; increment the empty line counter, or strip it later. Replace indent
+ ; -1 by indent 0 afterwards.
+ loop
+ append indent-and-symbols : list parsedline
+ . #t ; inindent
+ if : <= 2 emptylines
+ . #f ; chunk ends here
+ equal? #\_ : peek-char port ; are we in underscore indent?
+ . #f ; incomment
+ . 0
+ . '()
+ . emptylines
+ : equal? #t incomment
+ read-char port ; remove one comment character
+ loop
+ . indent-and-symbols
+ . #f ; inindent
+ . #f ; inunderscoreindent
+ . #t ; incomment
+ . 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 ; inindent
+ . #f ; inunderscoreindent
+ . #f ; incomment
+ . currentindent
+ . currentsymbols
+ . emptylines
+ ; | cludge to appease the former wisp parser
+ ; | which had a problem with the literal comment
+ ; v char.
+ : equal? (string-ref ";" 0) next-char
+ loop
+ . indent-and-symbols
+ . #f ; inindent
+ . #f ; inunderscoreindent
+ . #t ; incomment
+ . currentindent
+ . currentsymbols
+ . emptylines
+ else ; use the reader
+ loop
+ . indent-and-symbols
+ . #f ; inindent
+ . #f ; inunderscoreindent
+ . #f ; incomment
+ . currentindent
+ ; this also takes care of the hashbang and leading comments.
+ ; TODO: If used from Guile, activate curly infix via read-options.
+ 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 line"
+ ; 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
+ : equal? readcolon : car unprocessed
+ loop
+ ; FIXME: This should turn unprocessed into a list.
+ 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. We need to kill the colon before replacing inline colons."
+ if
+ equal?
+ line-code line
+ list readcolon
+ list : 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 target."
+ catch #t
+ lambda ()
+ set-source-properties! target : source-properties source
+ lambda : key . arguments
+ . #f
+ . target
+
+define : wisp-propagate-source-properties code
+ . "Propagate the source properties from the sourrounding list into every part of the code."
+ let loop
+ : processed '()
+ unprocessed code
+ cond
+ : and (null? processed) (not (pair? unprocessed)) (not (list? unprocessed))
+ . 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
+
+define : wisp-scheme-indentation-to-parens lines
+ . "Add parentheses to lines and remove the indentation markers"
+ ; FIXME: Find new algorithm which mostly uses current-line
+ ; and the indentation-levels for tracking. The try I have in
+ ; here right now is wrong.
+ when
+ and
+ not : null? lines
+ not : line-empty-code? : car lines
+ not : = 0 : line-real-indent : car lines ; -1 is a line with a comment
+ throw 'wisp-syntax-error
+ format #f "The first symbol in a chunk must start at zero indentation. Indentation and line: ~A"
+ car lines
+ let loop
+ : processed '()
+ unprocessed lines
+ indentation-levels '(0)
+ let*
+ :
+ current-line
+ if : <= 1 : length unprocessed
+ car unprocessed
+ list 0 ; empty code
+ next-line
+ if : <= 2 : length unprocessed
+ car : cdr unprocessed
+ list 0 ; empty code
+ current-indentation
+ car indentation-levels
+ current-line-indentation : line-real-indent current-line
+ ; format #t "processed: ~A\ncurrent-line: ~A\nnext-line: ~A\nunprocessed: ~A\nindentation-levels: ~A\ncurrent-indentation: ~A\n\n"
+ ; . processed current-line next-line unprocessed indentation-levels current-indentation
+ cond
+ ; the real end: this is reported to the outside world.
+ : and (null? unprocessed) (not (null? indentation-levels)) (null? (cdr indentation-levels))
+ ; display "done\n"
+ ; reverse the processed lines, because I use cons.
+ . processed
+ ; the recursion end-condition
+ : and (null? unprocessed)
+ ; display "last step\n"
+ ; 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
+ ; display "indentation-levels null\n"
+ throw 'wisp-programming-error "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-counting.
+ cond
+ : line-empty-code? current-line
+ ; display "current-line empty\n"
+ ; We cannot process indentation without
+ ; code. Just switch to the next line. This should
+ ; only happen at the start of the recursion.
+ ; TODO: Somehow preserve the line-numbers.
+ loop
+ . processed
+ cdr unprocessed
+ . indentation-levels
+ : and (line-empty-code? next-line) : <= 2 : length unprocessed
+ ; display "next-line empty\n"
+ ; TODO: Somehow preserve the line-numbers.
+ ; take out the next-line from unprocessed.
+ loop
+ . processed
+ cons current-line
+ cdr : cdr unprocessed
+ . indentation-levels
+ : > current-indentation current-line-indentation
+ ; display "current-indent > next-line\n"
+ ; this just steps back one level via the side-recursion.
+ values processed unprocessed
+ : = current-indentation current-line-indentation
+ ; display "current-indent = next-line\n"
+ let
+ : line : line-finalize current-line
+ next-line-indentation : line-real-indent next-line
+ cond
+ : >= current-line-indentation next-line-indentation
+ ; simple recursiive step to the next line
+ ; display "current-line-indent >= next-line-indent\n"
+ loop
+ append processed
+ if : line-continues? current-line
+ . line
+ wisp-add-source-properties-from line : list line
+ cdr unprocessed ; recursion here
+ . indentation-levels
+ : < current-line-indentation next-line-indentation
+ ; display "current-line-indent < next-line-indent\n"
+ ; format #t "line: ~A\n" line
+ ; side-recursion via a sublist
+ let-values
+ :
+ : sub-processed sub-unprocessed
+ loop
+ . line
+ cdr unprocessed ; recursion here
+ . indentation-levels
+ ; format #t "side-recursion:\n sub-processed: ~A\n processed: ~A\n\n" sub-processed processed
+ loop
+ append processed : list sub-processed
+ . sub-unprocessed ; simply use the recursion from the sub-recursion
+ . indentation-levels
+ : < current-indentation current-line-indentation
+ ; display "current-indent < next-line\n"
+ loop
+ . processed
+ . unprocessed
+ cons ; recursion via the indentation-levels
+ . current-line-indentation
+ . indentation-levels
+ else
+ throw 'wisp-not-implemented
+ format #f "Need to implement further line comparison: current: ~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 line"
+ let loop
+ : processed '()
+ unprocessed lines
+ if : null? unprocessed
+ . processed
+ loop
+ append processed : list : line-replace-inline-colons : car unprocessed
+ 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 :"
+ match code
+ : a ...
+ map wisp-unescape-underscore-and-colon a
+ '\_
+ . '_
+ '\:
+ . ':
+ a
+ . a
+
+
+define : wisp-replace-empty-eof code
+ . "replace ((#<eof>)) by ()"
+ ; FIXME: Actually 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 code))) (null? (cdr code)) (null? (cdr (car code)))
+ list
+ . code
+
+
+define : wisp-replace-paren-quotation-repr code
+ . "Replace lists starting with a quotation symbol by
+ quoted lists."
+ 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-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
+ : 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!"
+ 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
+ throw 'wisp-syntax-error (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 from wisp-scheme itself. Why?
+ : 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd . c
+ syntax-error tocheck "dot as first element in already improper pair"
+ ; simple pair, other way round
+ : a . 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd
+ syntax-error tocheck "dot as last element in already improper pair"
+ ; more complex pairs
+ : ? pair? a
+ let
+ : head : drop-right a 1
+ tail : last-pair a
+ 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"
+ 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
+
+
+;;;; Test special syntax
+; ;; quote the list
+; write
+; wisp-scheme-read-string "moo
+; foo
+; ' bar
+; baz waz"
+; newline
+; ;; quote the symbol - in wisp, whitespace after quote is not allowed!
+; write
+; wisp-scheme-read-string "moo
+; foo
+; 'bar
+; baz waz"
+; newline
+; ; ;; quote the list with colon
+; write
+; wisp-scheme-read-string "moo : ' foo
+; foo
+; ' bar bah
+; baz waz"
+; newline
+; ; ;; syntax the list
+; write
+; wisp-scheme-read-string "moo : #' foo
+; foo
+; #' bar bah
+; baz waz"
+; newline
+;
+;;;; Test improper lists
+;;;; Good cases
+; write
+; wisp-scheme-read-string "foo . bar"
+; newline
+; write
+; wisp-scheme-read-string "foo .
+; . bar"
+; newline
+; write
+; wisp-scheme-read-string "foo
+; . . bar"
+; newline
+; write
+; wisp-scheme-read-string "moo
+; foo
+; . . bar
+; baz waz"
+; newline
+;;;; Syntax Error cases
+; write
+; wisp-scheme-read-string "foo
+; . . ."
+; newline
+; write
+; wisp-scheme-read-string "moo : . . bar"
+; write
+; wisp-scheme-read-string "foo .
+; . . bar"
+; newline
+; write
+; wisp-scheme-read-string "moo
+; foo
+; . . bar baz
+; baz waz"
+; newline
+;;;; stranger stuff
+; write
+; wisp-scheme-read-string "foo ; bar\n ; nop \n\n; nup\n; nup \n \n\n\nfoo : moo \"\n\" \n___ . goo . hoo"
+; newline
+; display
+; wisp-scheme-read-string " foo ; bar\n ; nop \n\n; nup\n; nup \n \n\n\nfoo : moo"
+; newline
+; write : wisp-scheme-read-file-chunk "wisp-scheme.w"
+; newline
+; call-with-output-file "wisp-guile.scm"
+; lambda : port
+; map
+; lambda : chunk
+; write chunk port
+; wisp-scheme-read-file "wisp-guile.w"
+; run all chunks in wisp-guile.w as parsed by wisp-scheme.w. Give wisp-guile.w to parse as argument.
+; map primitive-eval : wisp-scheme-read-file "wisp-guile.w" ; actually runs wisp-guile.w with the arguments supplied to this script.
+; uncomment the previous line, then run the next line in the shell. If 1 and 2 are equal, this parser works!
+; guile wisp.scm wisp-scheme.w > wisp-scheme.scm; guile wisp-scheme.scm wisp-guile.w > 1; guile wisp.scm wisp-guile.w > 2; diff 1 2
+
diff --git a/examples/cholesky.w b/examples/cholesky.w
new file mode 100644
--- /dev/null
+++ b/examples/cholesky.w
@@ -0,0 +1,46 @@
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples cholesky) main)' -s "$0" "$@"
+; !#
+
+;; Cholesky decomposition, following https://de.wikipedia.org/wiki/Cholesky-Zerlegung#Pseudocode
+
+define-module : examples cholesky
+ . #:exports : cholesky!
+
+use-modules : guildhall ext foof-loop
+
+define : matrrix-ref X u v
+ list-ref (list-ref X u) v
+
+define : matrrix-set! X u v val
+ list-set! (list-ref X u) v val
+
+
+define : cholesky! a
+ . "Modifies the square matirx a to contain its cholesky decomposition.
+
+sets a to g with a = ggT,
+
+a is represented as list of lists."
+ let : : n : length a
+ loop : : for i : up-from 1 : to n
+ loop : : for j : up-from 1 : to i
+ let : : sum : matrix-ref a i j
+ when : >= j 1
+ loop : : for k : up-from 1 : to {j - 1}
+ set! sum : - sum : * (matrix-ref a i k) (matrix-ref a j k)
+ cond
+ : > i j ; lower triangle
+ matrix-set! a i j
+ / sum : matrix-ref a j j
+ . a
+ : > sum 0 ; diagonal element
+ matrix-set! a i i : sqrt sum
+ . a
+ else
+ throw 'matrix-numerically-not-symmetric-positive-definite
+
+
+define : main args
+ display : cholesky! '((1 2)(2 4))
diff --git a/examples/closure.w b/examples/closure.w
new file mode 100644
--- /dev/null
+++ b/examples/closure.w
@@ -0,0 +1,26 @@
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples closure) main)' -s "$0" "$@"
+; !#
+
+;; A simple example for a closure
+
+
+define counting-closure ; simple variable
+ let : : counter 0 ; provide counter to hold local data
+ lambda () ; the variable is bound to a function -> callable
+ set! counter : 1+ counter ; adjust the counter shared by all function calls
+ . counter
+
+
+; counter is created outside the function definition (lambda), so the
+; change survives over function calls. It is function-local data.
+
+
+define : main args
+ display : counting-closure
+ newline ; 1
+ display : counting-closure
+ newline ; 2
+ display : counting-closure
+ newline ; 3
diff --git a/examples/evolve.w b/examples/evolve.w
old mode 100644
new mode 100755
--- a/examples/evolve.w
+++ b/examples/evolve.w
@@ -1,20 +1,38 @@
-#!/home/arne/wisp/wisp-multiline.sh
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples evolve) main)' -s "$0" "$@"
; !#
-; A small experiment on a complete evolutionary algorithm.
+; One thousand monkeys: A small experiment on a complete evolutionary algorithm.
+
+; TODO: genetic with mutate+combinate, population which keeps the best and directed which only keeps improvements
; NOTE: This only works after preprocessing to scheme.
+define-module : examples evolve
+ . #:export : main
+
; Get the eval string which allows for selecting the language.
use-modules : ice-9 eval-string
+define evalsyntax "0123456789+-*/: ()"
-define evalsyntax "0123456789+-*/ ()"
+
+define : paired-char? char
+ or (equal? #\) char) (equal? #\( char)
+
define : mutate-replace evalstring
- let
+ let*
: eval-index : random : string-length evalstring
replace-index : random : string-length evalsyntax
+ remove-char : string-ref evalstring eval-index
+ insert-char : string-ref evalsyntax replace-index
+ ; double step, if mutating a paired character
+ evalstring
+ if : not : or (paired-char? insert-char) (paired-char? remove-char)
+ . evalstring
+ mutate-replace evalstring
string-replace evalstring evalsyntax eval-index : + eval-index 1
. replace-index : + replace-index 1
@@ -28,29 +46,44 @@ define : mutate-permutate evalstring
define : mutate-insert evalstring
- let
+ let*
: eval-index : random : string-length evalstring
insert-index : random : string-length evalsyntax
+ insert-char : string-ref evalsyntax insert-index
+ ; double step, if mutating a paired character
+ evalstring
+ if : not : paired-char? insert-char
+ . evalstring
+ mutate-insert evalstring
string-append
substring evalstring 0 eval-index
- string : string-ref evalsyntax insert-index
+ string insert-char
substring evalstring eval-index
+define : mutate-remove-by-index evalstring index
+ string-append
+ substring evalstring 0 index
+ substring evalstring : + index 1
+
+
define : mutate-remove evalstring
if : <= 1 : string-length evalstring
; cannot remove from a 0 string
. evalstring
- let
+ let*
: eval-index : random : - (string-length evalstring) 1
- string-append
- substring evalstring 0 eval-index
- substring evalstring : + eval-index 1
-
+ eval-char : string-ref evalstring eval-index
+ ; double step, if mutating a paired character
+ evalstring
+ if : not : paired-char? eval-char
+ . evalstring
+ mutate-remove evalstring
+ mutate-remove-by-index evalstring eval-index
define : mutate-eval evalstring
eval-string : string-append "(" evalstring ")"
- . #:lang 'scheme
+ . #:lang 'scheme ; TODO: use wisp
define : better mutated original
@@ -85,23 +118,45 @@ define : evolve-remove evalstring
evolve-step evalstring mutate-remove
+define : evolution-step string
+ let : : action : random 4
+ cond
+ : = action 0
+ evolve-replace string
+ : = action 1
+ evolve-permutate string
+ : = action 2
+ evolve-insert string
+ : = action 3
+ evolve-remove string
+
+
+define : evolution-population initialstring steps population-size
+ . "a population with 50% survivors."
+ . initialstring
+
define : evolution initialstring steps
+ ; TODO: use
let loop : (step 0) (string initialstring)
- let : : action : random 4
- if : >= step steps
- . string
- cond
- : = action 0
- loop (+ step 1) (evolve-replace string)
- : = action 1
- loop (+ step 1) (evolve-permutate string)
- : = action 2
- loop (+ step 1) (evolve-insert string)
- : = action 3
- loop (+ step 1) (evolve-remove string)
+ if : >= step steps
+ . string
+ loop
+ 1+ step
+ evolution-step string
+
-define : run
+define : main args
; firstoff, seed the random number generator!
set! *random-state* : random-state-from-platform
- display : evolution "+ 1 (- 2 1)" 1000
- newline
+ let
+ : opt : evolution "+ 123 (- 2 1)" 1000
+ write opt
+ newline
+ write : mutate-eval opt
+ newline
+
+
+define : main
+ display "foo"
+ newline
+ run
diff --git a/examples/hoist-in-loop.w b/examples/hoist-in-loop.w
new file mode 100644
--- /dev/null
+++ b/examples/hoist-in-loop.w
@@ -0,0 +1,105 @@
+;; This is partial example code taken from the loop optimization Guile code at
+;; http://git.savannah.gnu.org/gitweb/?p=guile.git;a=blob;f=module/language/cps/licm.scm;h=3b343a66bd8ed4a591a9e97edbf1179a4d3a78a8;hb=HEAD
+
+; I chose this example because this code felt very dense when I first
+; read it, so I wanted to check whether this improves with wisp
+; syntax.
+
+; but first the copyright information from the header of the file:
+
+;;; Continuation-passing style (CPS) intermediate language (IL)
+
+;; Copyright (C) 2013, 2014, 2015 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-1301 USA
+
+define : hoist-in-loop cps entry body-labels succs preds effects
+ let*
+ :
+ interior-succs
+ intmap-map
+ lambda : label succs
+ intset-intersect succs body-labels
+ . succs
+ sorted-labels : compute-reverse-post-order interior-succs entry
+ header-label : fresh-label
+ header-cont : intmap-ref cps entry
+ loop-vars
+ match header-cont
+ : $ $kargs names vars
+ list->intset vars
+ loop-effects
+ persistent-intmap
+ intset-fold
+ lambda : label loop-effects
+ let
+ :
+ label*
+ if : eqv? label entry
+ . header-label
+ . label
+ fx : intmap-ref effects label
+ intmap-add! loop-effects label* fx
+ body-labels empty-intmap
+ pre-header-label entry
+ pre-header-cont
+ match header-cont
+ : $ $kargs names vars term
+ let : : vars* : map (lambda (_) (fresh-var)) vars
+ build-cont
+ $kargs names vars*
+ $continue header-label #f
+ $values vars*
+ cps : intmap-add! cps header-label header-cont
+ cps : intmap-replace! cps pre-header-label pre-header-cont
+ to-visit
+ match sorted-labels
+ : head . tail
+ unless : eqv? head entry
+ error "what?"
+ cons header-label tail
+ define : rename-back-edges cont
+ define : rename label
+ if : eqv? label entry
+ . header-label
+ . label
+ rewrite-cont cont
+ : $ $kargs names vars : $ $continue kf src : $ $branch kt exp
+ $kargs names vars
+ $continue (rename kf) src : $branch (rename kt) ,exp
+ : $ $kargs names vars : $ $continue k src exp
+ $kargs names vars
+ $continue (rename k) src ,exp
+ : $ $kreceive ($ $arity req () rest) k
+ $kreceive req rest (rename k)
+ let lp
+ : cps cps
+ to-visit to-visit
+ loop-vars loop-vars
+ loop-effects loop-effects
+ pre-header-label pre-header-label
+ always-reached? #t
+ match to-visit
+ () cps
+ : label . to-visit
+ call-with-values
+ lambda :
+ hoist-one cps label (intmap-ref cps label) preds
+ . loop-vars loop-effects
+ . pre-header-label always-reached?
+ lambda : cps cont loop-vars loop-effects pre-header-label always-reached?
+ lp : intmap-replace! cps label : rename-back-edges cont
+ . to-visit
+ . loop-vars loop-effects pre-header-label always-reached?
diff --git a/examples/say.w b/examples/say.w
new file mode 100755
--- /dev/null
+++ b/examples/say.w
@@ -0,0 +1,25 @@
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples say) main)' -s "$0" "$@"
+; !#
+
+; Simple specialized syntax for writing natural text with scheme.
+
+define-module : examples say
+ . #:export : main
+
+; TODO: rewrite for syntax-case with recursion into sub-lists.
+; Goal: say Yes, this works ,(red 1 2) .
+
+; TODO: longterm goal: simply syntax for writing plays. The header
+; with active persons defines macros which are like say, but
+; personalized. The code should read like the output of
+; classical JRPGs.
+
+define-syntax-rule : say a ...
+ format #t "~A\n"
+ string-join
+ map symbol->string : quote : a ...
+
+define : main argv
+ say Yes, this works!
diff --git a/wisp-reader.w b/wisp-reader.w
--- a/wisp-reader.w
+++ b/wisp-reader.w
@@ -19,7 +19,18 @@ define-module : language wisp spec
. #:export : wisp
; Set locale to something which supports unicode. Required to avoid using fluids.
-setlocale LC_ALL ""
+catch #t
+ lambda :
+ setlocale LC_ALL ""
+ lambda : key . parameters
+ let : : locale-fallback "en_US.UTF-8"
+ format (current-error-port)
+ string-join
+ list "Warning: setlocale LC_ALL \"\" failed with ~A: ~A"
+ . "using explicit ~A locale. Please setup your locale.\n"
+ . "\n "
+ . key parameters locale-fallback
+ setlocale LC_ALL locale-fallback
;;;
;;; Language definition
diff --git a/wisp-scheme.w b/wisp-scheme.w
--- a/wisp-scheme.w
+++ b/wisp-scheme.w
@@ -222,6 +222,12 @@ define : indent-reduce-to-level indentat
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
@@ -246,6 +252,11 @@ define : wisp-scheme-read-chunk-lines po
append indent-and-symbols : list : append (list currentindent) currentsymbols
: and inindent (zero? currentindent) (not incomment) (not (null? indent-and-symbols)) (not inunderscoreindent) (not (or (equal? #\space next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) next-char)))
append indent-and-symbols ; top-level form ends chunk
+ : chunk-ends-with-period currentsymbols next-char
+ ; the line ends with a period. This is forbidden in
+ ; SRFI-119. Use it to end the line in the REPL without
+ ; showing continuation dots (...).
+ append indent-and-symbols : list : append (list currentindent) (drop-right currentsymbols 1)
: and inindent : equal? #\space next-char
read-char port ; remove char
loop