(Arne Babenhauserheide)
2016-07-12: merge new examples, autotools work, slides and bugfixes. stable v0.9.1 merge new examples, autotools work, slides and bugfixes.
diff --git a/.bugs/bugs b/.bugs/bugs
--- a/.bugs/bugs
+++ b/.bugs/bugs
@@ -1,15 +1,16 @@
testsuite: to pass, the tree-il has to match, not the emitted string. This allows for reader-only implementations. | owner:, open:False, id:00b74a730bbf076e73166e817ca7b0a273b376d4, time:1408224636.42
-wisp-scheme: backtraces should show the wisp source. | owner:Arne Babenhauserheide <bab@draketo.de>, open:True, id:0475df81a594a52d171a1b811752ca64e5a71df5, time:1426792099.58
+wisp-scheme: backtraces should show the wisp source. | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:0475df81a594a52d171a1b811752ca64e5a71df5, time:1426792099.58
wisp-scheme: unescape \_ and \: | owner:, open:False, id:086f61a06e16f1ef56e9917453bbd55b5879d15d, time:1415121255.99
fails when I add stuff at the end of end of example.w | owner:, open:False, id:08c68e1ce0c9798184c01806d2661a3220bff3cd, time:1363789693.79
wisp-mode in quoted lists only the first item is colorized as data, but all words up to the last paren should be colorized. | owner:, open:True, id:1675ca3f894ed8470fa292149a476a2fa0d17140, time:1397196957.45
add a testsuite for wisp parsers. | owner:, open:False, id:1c05d27ac916e1a823b8985a094947907c3c19af, time:1379064922.74
wisp-mode: export wisp to html fails in org-mode: font-lock-fontify-keywords-region: Invalid regexp | owner:, open:False, id:1e46d8c05580c961c37a32d36c987a5dd1d34943, time:1389371020.39
+wisp-scheme: commans like ,expand do not work due to stray leading space | owner:, open:True, id:20df756e6c7f61885857c2a67a7111884294f9aa, time:1444645835.87
an empty line with : should start with double parens | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:2e188ddf44d36e4605030d3c58607ebfa97d189e, time:1390328674.43
wisp-in-wisp: remove the leading . for continuation lines after inferring the brackets. | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:2e42e5b64622f0cc383eb8acc3d510912e925bf0, time:1377476687.79
-interpret ` , : correctly. | owner:, open:True, id:2feb5f048b55274c1bc7c8168c8cb358c0c8dd1d, time:1426777900.6
+interpret ` , : correctly. | owner:, open:False, id:2feb5f048b55274c1bc7c8168c8cb358c0c8dd1d, time:1426777900.6
'() gives REPR-QUOTE-... | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:30c42de75c137f483245898e2a62af1e65cf19a6, time:1415060388.34
-multiple escaped initial underscores must be unescaped. | owner:, open:True, id:314e45488da4c7c8298c4c64ece03359918d057b, time:1415959749.14
+multiple escaped initial underscores must be unescaped. | owner:, open:False, id:314e45488da4c7c8298c4c64ece03359918d057b, time:1415959749.14
wisp: handle general paren prefixes like quote, quasiquote, etc. | owner:, open:False, id:323ff94b5be635742619467e1cb44f4c0d96f63f, time:1379047798.47
throw an exception when reducing indentation to an unknown indentation level. | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:424186bd85f186b7279c5c59e2bd42f847284719, time:1376003568.91
LANG=C breaks bootstrap: python encoding error: it uses ascii. | owner:, open:True, id:43c7461bfb6f35a90ff3f4497c8232e2457ce1c7, time:1427819877.7
@@ -23,6 +24,7 @@ wisp-guile.w does not yet remove the lea
inline ' : should be '( | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:72d534a8b23b4cb168017f1bb7d8816f0ea170c4, time:1366497335.26
failing test tests/shebang.w | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:74a851f83af8996465a7b24d8453161beb0f0fd5, time:1379106761.57
non-nested multiline comments with #! !#. Requires restructuring. | owner:, open:False, id:7a57614fa920b2ddad002d044b144d0bb7c34f84, time:1389364108.01
+wisp-guile: multiline-stringsn break. See tests/multiline-string.w | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:7e457dfe042341ea24d0b57c4f0f48fa3d9affc3, time:1462055749.4
wisp-scheme: interpret , : as ,() similar to : , | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:85e150dcb10c49d8f51db525e07d24e83bdba0f1, time:1416432201.21
wisp-guile: support nested multi-line comments with #| ... |#: multiline comments (srfi-30). Requires restructuring. | owner:Arne Babenhauserheide <bab@draketo.de>, open:True, id:8cf6202873d4454f57813dd17cf60432059f7c62, time:1389569421.6
wisp-scheme: Does not recognize the . #!curly-infix request for curly-infix or other reader syntax. | owner:Arne Babenhauserheide <bab@draketo.de>, open:True, id:91f27adb7d4e378e034b3408b6e4616f707f9587, time:1418162368.88
@@ -37,6 +39,7 @@ make this work: let : : origfile ( open-
wisp.py breaks on \ - quote, escaped backslash, quote. Ignored, because wisp.py is only needed for bootstrapping. | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:d75a93ca58ade5b3e3e51f1e7ee9782e743ac131, time:1377424552.02
comments containing a closing parenthesis can break the parser. | owner:, open:False, id:d9147504868960e5fbc2648474d48ce5c9bd1a02, time:1374838747.22
breaks on empty files | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:e40fa7a93eb2c497dca1af7eed22ad5ed5cfbe7f, time:1390325470.91
+quoting and unquoting sometimes breaks | owner:, open:True, id:e445b9ed2403cd366e556f384129c08970f0b77a, time:1444647166.82
wisp-scheme: breaks on lines with only underscores. These should be treated as empty lines. | owner:, open:False, id:e464b5ce49deb14a80f67d50c6d70043ca9bde25, time:1415124488.16
quote as only char in a line gets parenthized instead of becoming a paren-prefix. | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:eb7468387e90bb5d13f5a5d81c6f4a704f2ca0fb, time:1390326369.6
in the REPL output can be delayed by one line: Appears only when submitting the next command. | owner:, open:False, id:f1e42bbd4c17a2dec886c26d9c14e770bcff66d2, time:1415972414.48
diff --git a/.bugs/details/e445b9ed2403cd366e556f384129c08970f0b77a.txt b/.bugs/details/e445b9ed2403cd366e556f384129c08970f0b77a.txt
new file mode 100644
--- /dev/null
+++ b/.bugs/details/e445b9ed2403cd366e556f384129c08970f0b77a.txt
@@ -0,0 +1,46 @@
+# Lines starting with '#' and sections without content
+# are not displayed by a call to 'details'
+#
+[paths]
+# Paths related to this bug.
+# suggested format: REPO_PATH:LINENUMBERS
+
+
+[details]
+# Additional details
+
+This is a collection of problems connected to quoting.
+
+
+` ,(+ 1 2) ,(+ 2 3) , : + 4 5
+
+should be equivalent to
+
+`(,(+ 1 2) ,(+ 2 3) ,(+ 4 5))
+
+but gives
+
+(REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd (unquote (+ 1 2)) (unquote (+ 2 3)) (unquote (+ 4 5))
+
+this works:
+
+` ,(+ 1 2) ,(+ 2 3) : , + 4 5
+
+display ` , : + 1
+should give (display `(,(+ 1)))
+but gives (display `(,((+ 1))))
+
+[expected]
+# The expected result
+
+
+[actual]
+# What happened instead
+
+
+[reproduce]
+# Reproduction steps
+
+
+[comments]
+# Comments and updates - leave your name
diff --git a/Makefile.am b/Makefile.am
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,37 +1,55 @@
-wisp = wisp-scheme.scm language/wisp/spec.scm
-wisp_SOURCES = wisp-guile.w wisp-reader.w wisp-scheme.w
-EXTRA_DIST = $(wisp_SOURCES) $(wisp_DATA) bootstrap.sh bootstrap-reader.sh examples tests wisp-repl-guile.sh testrunner.w wisp.py wisp.scm
-CLEANFILES = ${wisp} ChangeLog
-DISTCLEANFILES = ${CLEANFILES} @abs_top_builddir@/1 @abs_top_builddir@/2 @abs_top_builddir@/syntaxtests.sh @abs_top_builddir@/syntaxtestsreader.sh
+SUFFICES = .w .scm .sh
+
+sitedir = $(GUILE_SITE)
+site_DATA = wisp-scheme.scm
+
+langdir = ${datarootdir}/guile/$(GUILE_EFFECTIVE_VERSION)/language/wisp
+lang_DATA = language/wisp/spec.scm
+
+WISP = wisp-guile.w wisp-reader.w wisp-scheme.w
+
+EXTRA_DIST = $(WISP) bootstrap.sh bootstrap-reader.sh examples tests wisp-repl-guile.sh testrunner.w wisp.py wisp.scm
+CLEANFILES = 1 2
+DISTCLEANFILES = $(lang_DATA) $(site_DATA)
# don't spout out lots of stuff at each distcheck. Disable for debugging.
AM_DISTCHECK_CONFIGURE_FLAGS="--quiet"
-
-all : ${wisp}
-
ChangeLog :
hg log --style changelog > ChangeLog
-# emacs org-mode beamer build instructions
-${wisp} : input.in.intermediate
-
-.INTERMEDIATE: input.in.intermediate
-input.in.intermediate: ${wisp_SOURCES} wisp.scm
- @abs_top_srcdir@/bootstrap-reader.sh @abs_top_srcdir@ @abs_top_builddir@ @guile@ wisp.scm 2>&1 | sed "s/^;;;.*//" 2>&1 | grep . 1>&2 ; test ! $$? -eq 0 # it worked if grep does not find anything
+.INTERMEDIATE: .mydatastuff
+$(site_DATA) $(lang_DATA): .wispbootstrap
+.wispbootstrap : ${WISP} wisp.scm
+ @abs_top_srcdir@/bootstrap-reader.sh @abs_top_srcdir@ @abs_top_builddir@ @GUILE@ wisp.scm 2>&1 | sed "s/^;;;.*//" 2>&1 | grep . 1>&2 ; test ! $$? -eq 0 # it worked if grep does not find anything
wisp.scm: wisp-guile.w wisp.py
- @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
+ @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
+.INTERMEDIATE: syntaxtests.sh
syntaxtests.sh : wisp.scm tests/runtests-scheme-preprocessor.sh
- echo '#!/bin/bash' > @abs_top_builddir@/$@
+ echo '#!/usr/bin/env bash' > @abs_top_builddir@/$@
echo @abs_top_srcdir@/tests/runtests-scheme-preprocessor.sh @abs_top_srcdir@ @abs_top_builddir@ >> @abs_top_builddir@/$@
chmod +x @abs_top_builddir@/$@
-.PHONY: syntaxtestsreader.sh
-syntaxtestsreader.sh : ${wisp} wisp.scm tests/runtests-scheme-reader.sh
- echo '#!/bin/bash' > @abs_top_builddir@/$@
+.INTERMEDIATE: syntaxtestsreader.sh
+syntaxtestsreader.sh : ${WISP} wisp.scm tests/runtests-scheme-reader.sh
+ echo '#!/usr/bin/env bash' > @abs_top_builddir@/$@
echo @abs_top_srcdir@/tests/runtests-scheme-reader.sh @abs_top_srcdir@ @abs_top_builddir@ >> @abs_top_builddir@/$@
chmod +x @abs_top_builddir@/$@
TESTS=syntaxtests.sh syntaxtestsreader.sh
+
+# The installchecks won't work in a "make distcheck", because
+# they won't be installed in the final location used by the tools.
+# FIXME: automake should honor DESTDIR set by make distcheck
+if IS_MAKE_DISTCHECK
+install-siteDATA:
+ echo "Running 'make distcheck'; local installchecks disabled."
+install-langDATA:
+ echo "Running 'make distcheck'; local installchecks disabled."
+uninstall-siteDATA:
+ echo "Running 'make distcheck'; local installchecks disabled."
+uninstall-langDATA:
+ echo "Running 'make distcheck'; local installchecks disabled."
+else !IS_MAKE_DISTCHECK
+endif !IS_MAKE_DISTCHECK
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,7 +1,38 @@
+wisp ():
+-
+
+wisp 0.9.1:
+- add enter three witches: minimum overhead for a theater script
+- examples/with.w: syntax for a with keyword
+ which works like with in Python
+- wisp-mode: add indentation cycling patch
+- Use GUILE_PKG instead of PKG_CHECK_MODULES
+ thanks to Jan Wedekind
+- "make install" adds the wisp language to Guile
+ thanks to Jan Wedekind
+- add examples/securepassword.w
+- add slides for FOSDEM 2016 talk
+- examples/d20world.w: implement basic plotting on a map.
+- more of the examples use the guile reader by default
+ thanks to Kevin W. van Rooijen
+- examples/d6.w: add critical rolls
+- use GUILE_PROGS to check for guile instead of using homegrown stuff
+- fix multiline string bug when the string includes \"
+ tracked down by Michael Lamb
+- new example: say.w (companion to
+ http://draketo.de/english/wisp/shakespeare )
+- add running mean and async
+- add ensemble estimation
+- always use /usr/bin/env bash as hashbang for shell scripts.
+- fix factorial code
+- improve handling of "` , :" (incomplete, see bug e44)
+- unescape up to 6 leading underscores (fix bug 31)
+
wisp 0.9.0 (2015-09-24):
- actually distribute wisp.scm
- wisp now starts from wisp.scm. To bootstrap a release from Python,
remove wisp.scm and run `make wisp.scm`
+ starting with 0.9.0, installing wisp no longer depends on Python.
wisp 0.8.7 (2015-09-24):
- new example say.w, companion to
diff --git a/bootstrap-reader.sh b/bootstrap-reader.sh
--- a/bootstrap-reader.sh
+++ b/bootstrap-reader.sh
@@ -1,4 +1,4 @@
-#!/bin/bash
+#!/usr/bin/env bash
if [[ x"$1" == x"" ]]; then
srcdir=.
diff --git a/bootstrap.sh b/bootstrap.sh
--- a/bootstrap.sh
+++ b/bootstrap.sh
@@ -1,4 +1,4 @@
-#!/bin/bash
+#!/usr/bin/env 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,18 +1,38 @@
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.9.0],
+AC_INIT([wisp], [0.9.1],
[arne_bab@web.de])
# Check for programs I need for my build
AC_CANONICAL_TARGET
-AC_ARG_VAR([guile], [How to call GNU Guile 2.0.x.])
-AC_CHECK_TARGET_TOOL([guile], [guile-2.0], [no])
-AS_IF([test "x$guile" = "xno"],
- [AC_MSG_ERROR([cannot find GNU Guile 2.0 or later.])])
+
+# search for Guile using the guile m4 files.
+# see https://www.gnu.org/software/guile/manual/html_node/Autoconf-Macros.html
+# This provides @GUILE@ to Makefile.am
+GUILE_PKG([2.2 2.0 1.8])
+GUILE_PROGS
+GUILE_SITE_DIR
+
+dnl set installation prefix for language file to Guile location
+AC_PREFIX_PROGRAM([guile])
+
AC_ARG_VAR([python3], [How to call Python 3.])
AC_CHECK_TARGET_TOOL([python3], [python3], [no])
AS_IF([test "x$python3" = "xno"],
- [AC_MSG_ERROR([cannot find Python 3 which is required for bootstrapping.])])
+ [AC_MSG_WARN([cannot find Python 3 which is required for development bootstrapping.])])
+
+# Is this a normal install, or a "make distcheck"? We need to disable
+# the tests in a "make distcheck" that won't work.
+# FIXME: automake should honor DESTDIR set by make distcheck
+is_make_distcheck=no
+AS_CASE([$prefix],
+ [*/_inst],
+ [AC_MSG_NOTICE([[Prefix ends in /_inst; this is a 'make distcheck'.]])
+ is_make_distcheck=yes])
+AM_CONDITIONAL([IS_MAKE_DISTCHECK], [test "x$is_make_distcheck" = x"yes"])
+AC_MSG_CHECKING([final decision IS_MAKE_DISTCHECK (running "make distcheck"?)])
+AM_COND_IF([IS_MAKE_DISTCHECK], [AC_MSG_RESULT([yes])], [AC_MSG_RESULT([no])])
+
# Run automake
# Use GNU style. Note that ChangeLog is created on every commit
# by a commit hook in .hg/hgrc
@@ -21,4 +41,5 @@ AS_IF([test "x$python3" = "xno"],
AM_INIT_AUTOMAKE([gnu])
AM_MAINTAINER_MODE([enable])
AC_CONFIG_FILES([Makefile])
+
AC_OUTPUT
diff --git a/docs/fosdem2016.org b/docs/fosdem2016.org
new file mode 100644
--- /dev/null
+++ b/docs/fosdem2016.org
@@ -0,0 +1,454 @@
+#+title:
+# ^ no title page, but title on the slides
+#+LATEX: \title{wisp}
+
+#+LaTeX_CLASS: beamer
+#+LaTeX_CLASS_OPTIONS: [presentation]
+#+BEAMER_THEME: Boadilla
+#+options: toc:nil
+
+#+latex: \renewcommand{\inserttotalframenumber}{10}
+
+
+* Wisp - SRFI-119
+
+#+latex: \vspace{1.3cm}
+
+** :B_columns:
+ :PROPERTIES:
+ :BEAMER_env: columns
+ :END:
+*** :BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.42
+ :END:
+
+#+BEGIN_SRC wisp
+define : factorial n
+ if : zero? n
+ . 1
+ * n : factorial {n - 1}
+#+END_SRC
+
+** :B_quote:
+ :PROPERTIES:
+ :BEAMER_env: quote
+ :END:
+
+#+latex: \vspace{1.3cm}
+
+\begin{center}
+I love the syntax of Python, \\
+but crave the simplicity and power of Lisp.
+\end{center}
+
+
+* Why Wisp?
+
+
+
+**
+ :PROPERTIES:
+ :BEAMER_act: <2-2>
+ :END:
+
+\centering
+\Large
+
+\textyen Hello World!\pounds
+
+**
+ :PROPERTIES:
+ :BEAMER_act: <3-4>
+ :END:
+
+\centering
+\Large
+
+Hello World!
+
+**
+ :PROPERTIES:
+ :BEAMER_act: <1-1>
+ :END:
+
+\centering
+\Large
+
+(Hello World!)
+
+** Notes :B_quote:
+ :PROPERTIES:
+ :BEAMER_act: <4-4>
+ :BEAMER_env: quote
+ :END:
+
+- The first and last letter are important for word recognition.¹
+
+- Over 70% of the codelines in the Guile scheme source start with a paren \Rightarrow ceremony.
+
+- Many people avoid Lisp-like languages because of the parens.²
+
+\footnotesize
+
+¹: Though not all-important. See \\ [[http://www.mrc-cbu.cam.ac.uk/people/matt.davis/cmabridge/][www.mrc-cbu.cam.ac.uk/people/matt.davis/cmabridge/]]
+
+²: Also see [[http://srfi.schemers.org/srfi-110/srfi-110.html#cant-improve][srfi.schemers.org/srfi-110/srfi-110.html#cant-improve]]
+
+* The most common letters: Lisp and Scheme are awesome
+
+**
+
+\centering
+\Huge
+=.,":'_#?!;=
+
+** :B_ignoreheading:
+ :PROPERTIES:
+ :BEAMER_env: ignoreheading
+ :END:
+
+\centering
+/The most common non-letter, non-math characters in prose¹/
+
+\vspace{0.3cm}
+
+**
+
+\centering
+\Huge
+=()=
+
+** :B_ignoreheading:
+ :PROPERTIES:
+ :BEAMER_env: ignoreheading
+ :END:
+
+\centering
+/The most common paired characters¹/
+
+** :B_ignoreheading:
+ :PROPERTIES:
+ :BEAMER_env: ignoreheading
+ :END:
+
+
+\vspace{0.5cm}
+
+\raggedright
+\footnotesize
+¹: From letter distributions in newspapers, see: \\ [[https://bitbucket.org/ArneBab/evolve-keyboard-layout/src/tip/1-gramme.arne.txt][bitbucket.org/ArneBab/evolve-keyboard-layout/src/tip/1-gramme.arne.txt]]
+
+* Wisp in a nutshell
+** :B_columns:
+ :PROPERTIES:
+ :BEAMER_env: columns
+ :END:
+
+
+
+*** :BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.48
+ :END:
+\vspace{0.5cm}
+
+#+BEGIN_SRC wisp
+define : factorial n
+ if : zero? n
+ . 1
+ * n : factorial {n - 1}
+#+END_SRC
+
+
+*** :BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.48
+ :END:
+\vspace{0.5cm}
+
+#+BEGIN_SRC wisp
+(define (factorial n)
+ (if (zero? n)
+ 1
+ (* n (factorial {n - 1}))))
+#+END_SRC
+
+** :B_ignoreheading:
+ :PROPERTIES:
+ :BEAMER_env: ignoreheading
+ :END:
+
+\vspace{1cm}
+
+\footnotesize
+
+- indent as with parens, dot-prefix, inline-:, and use SRFI-105.
+
+- Wisp uses the minimal syntax required to represent arbitrary structure: \\ Syntax justification: [[http://draketo.de/english/wisp#sec-4][draketo.de/english/wisp#sec-4]]
+
+- Many more examples in “From Python to Guile Scheme”: \\ info: [[http://draketo.de/py2guile][draketo.de/py2guile]] \\ download: [[http://draketo.de/proj/py2guile/py2guile.pdf][draketo.de/proj/py2guile/py2guile.pdf]]
+
+
+* Implementation
+
+** REPL and Reader (language wisp spec) :B_block:BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.57
+ :BEAMER_env: block
+ :END:
+
+#+BEGIN_SRC wisp
+ define-language wisp
+ . #:title "Wisp Scheme Syntax.."
+ . #:reader read-one-wisp-sexp
+ . #:compilers `(
+ (tree-il . ,compile-tree-il))
+ . #:decompilers `(
+ (tree-il . ,decompile-tree-il))
+ . #:evaluator (lambda (x module)
+ primitive-eval x)
+ . #:printer write
+ . #:make-default-environment
+ lambda :
+ let : : m : make-fresh-user-module
+ module-define! m 'current-reader
+ make-fluid
+ module-set! m 'format simple-format
+ . m
+#+END_SRC
+
+** Preprocessor (wisp.scm) :B_block:BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.39
+ :BEAMER_env: block
+ :END:
+
+#+BEGIN_SRC sh
+guile wisp.scm tests/hello.w
+#+END_SRC
+
+#+BEGIN_SRC scheme
+(define (hello who)
+ ;; include the newline
+ (format #t "~A ~A!\n"
+ "Hello" who))
+(hello "Wisp")
+#+END_SRC
+
+\footnotesize
+(Plan B: You can always go back)
+
+
+* Applications?
+** :BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.50
+ :END:
+
+*** Example: User Scripts
+
+#+BEGIN_SRC wisp
+Enter : First_Witch
+ Second_Witch
+ Third_Witch
+
+First_Witch
+ When shall we three meet again
+ In thunder, lightning, or in rain?
+#+END_SRC
+
+*** :B_ignoreheading:
+ :PROPERTIES:
+ :BEAMER_env: ignoreheading
+ :END:
+
+This displays
+
+*** :B_block:
+ :PROPERTIES:
+ :BEAMER_env: block
+ :END:
+\footnotesize
+#+BEGIN_EXAMPLE
+First Witch
+ When shall we three meet again
+ In thunder, lightning, or in rain?
+#+END_EXAMPLE
+
+*** :B_ignoreheading:
+ :PROPERTIES:
+ :BEAMER_env: ignoreheading
+ :END:
+
+\footnotesize
+- [[http://draketo.de/english/wisp/shakespeare][draketo.de/english/wisp/shakespeare]]
+- Templates, executable pseudocode, REPL-interaction, configuration, ...
+
+* Solutions
+
+** Run examples/newbase60.w as script
+
+#+BEGIN_SRC wisp
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp \
+ -e '(@@ (examples newbase60) main)' \
+ -s "$0" "$@"
+; !#
+define-module : examples newbase60
+
+define : main args
+ ...
+#+END_SRC
+
+** Use Wisp code from parenthesized Scheme
+
+- precompile: =guile --language=wisp module=
+- then just import as usual: =(use-modules (...))=
+
+* Experience
+
+** :B_quote:
+ :PROPERTIES:
+ :BEAMER_env: quote
+ :END:
+
+\vspace{1cm}
+
+»ArneBab's alternate sexp syntax is best I've seen; pythonesque, hides parens but keeps power« — Christopher Webber \\ \rightarrow [[http://dustycloud.org/blog/wisp-lisp-alternative/][dustycloud.org/blog/wisp-lisp-alternative/]]
+
+\vspace{1cm}
+
+** :B_block:
+ :PROPERTIES:
+ :BEAMER_env: block
+ :END:
+
+- Wisp is implemented in Wisp (850 lines, two implementations).
+- Examples: 4 lines (factorial) to 330 lines (advection on icosaheder).
+
+* Try Wisp
+
+** Install
+
+#+BEGIN_SRC sh
+guix package -i guile guile-wisp
+guile --language=wisp
+#+END_SRC
+
+#+BEGIN_SRC sh
+wget https://bitbucket.org/ArneBab/wisp/downloads/wisp-0.9.0.tar.gz;
+tar xf wisp-0.9.0.tar.gz ; cd wisp-0.9.0/;
+./configure; make check;
+examples/newbase60.w 123
+#+END_SRC
+
+- [[http://draketo.de/english/wisp][http://draketo.de/english/wisp]]
+
+** Emacs mode for syntax highlighting
+
+- M-x package-install [RET] *wisp-mode* [RET]
+- https://marmalade-repo.org/packages/wisp-mode
+
+
+* Thank you!
+
+*** :B_alertblock:BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.032
+ :BEAMER_env: alertblock
+ :END:
+
+$\ddot \smile$
+
+* Appendix :B_appendix:
+ :PROPERTIES:
+ :BEAMER_env: appendix
+ :END:
+
+* Why not SRFI-110 or SRFI-49?
+
+** SRFI-49 :BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.45
+ :END:
+
+*** SRFI-49 :B_block:
+ :PROPERTIES:
+ :BEAMER_env: block
+ :END:
+
+#+BEGIN_SRC wisp
+ + 5
+ * 4 3
+ 2
+ 1
+ 0
+#+END_SRC
+
+- Cannot continue the argument list
+
+*** Wisp :B_block:
+ :PROPERTIES:
+ :BEAMER_env: block
+ :END:
+
+#+BEGIN_SRC wisp
+ + 5
+ * 4 3
+ . 2 1 0
+
+#+END_SRC
+
+** SRFI-110 :B_block:BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.45
+ :BEAMER_env: block
+ :END:
+
+#+BEGIN_SRC wisp
+myfunction
+ x: \\ original-x
+ y: \\ calculate-y original-y
+#+END_SRC
+
+#+BEGIN_SRC wisp
+ a b $ c d e $ f g
+#+END_SRC
+
+#+BEGIN_SRC wisp
+ let <* x getx() \\ y gety() *>
+ ! {{x * x} + {y * y}}
+#+END_SRC
+
+- most common letters?
+
+* Keep parens where they help readability
+
+
+** :BMCOL:
+ :PROPERTIES:
+ :BEAMER_col: 0.45
+ :END:
+
+
+#+BEGIN_SRC wisp
+cond
+ : and (null? l) (zero? a)
+ . '()
+ else
+ cons a l
+#+END_SRC
+
+
+#+BEGIN_SRC wisp
+map
+ lambda (x) (+ x 1)
+ list 1 2 3
+#+END_SRC
+
+
+# Local Variables:
+# org-latex-minted-options: (("linenos" "false") ("frame" "lines") ("framesep" "6pt") ("fontsize" "\\footnotesize"))
+# End:
diff --git a/docs/interactive-run.txt b/docs/interactive-run.txt
new file mode 100755
--- /dev/null
+++ b/docs/interactive-run.txt
@@ -0,0 +1,31 @@
+#!/bin/sh
+guile -L . --language=wisp << EOF
+
+display "Hello World!\n" .
+
+define : hello
+ display "Hello World!"
+ newline .
+
+hello .
+
+define-syntax-rule : hello who
+ format #t "Hello ~A!\n" (symbol->string 'who)
+
+
+hello World .
+
+define-syntax-rule : welcome-to what
+ format #t "Welcome to ~A!\n" : symbol->string 'what .
+
+welcome-to Wisp .
+
+define-syntax-rule : welcome-to . what
+ format #t "Welcome to ~A!\n"
+ string-join : map symbol->string 'what .
+
+welcome-to syntax like Python with the simplicity and power of Lisp .
+
+display 'http://draketo.de/english/wisp
+newline
+EOF
diff --git a/examples/cholesky.w b/examples/cholesky.w
old mode 100644
new mode 100755
--- a/examples/cholesky.w
+++ b/examples/cholesky.w
@@ -6,7 +6,7 @@ exec guile -L $(dirname $(dirname $(real
;; Cholesky decomposition, following https://de.wikipedia.org/wiki/Cholesky-Zerlegung#Pseudocode
define-module : examples cholesky
- . #:exports : cholesky!
+ . #:export : cholesky!
use-modules : guildhall ext foof-loop
diff --git a/examples/d20world.w b/examples/d20world.w
--- a/examples/d20world.w
+++ b/examples/d20world.w
@@ -1,4 +1,6 @@
-#!/home/arne/wisp/wisp-multiline.sh
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples d20world) main)' -s "$0" "$@"
; !#
; A world projected on a d20 (20-sided die, ikosaeder)
@@ -17,6 +19,7 @@ define-module : examples d20world
. #:export : world neighbors d20-as-text d20-diffuse
use-modules : ice-9 format
+use-modules : srfi srfi-1
use-modules
: ice-9 popen
. #:select : open-output-pipe close-pipe
@@ -188,150 +191,266 @@ define : d20-advect world advection-dire
loop : cdr neighbors-to-advect
-define φ : * (/ 1 2) : 1+ : sqrt 5
+define d20numbers '(1 14 10 6
+ 19 18 4 8 9 16
+ 2 3 17 13 12 5
+ 11 15 7 20)
+
+define : cellidx->dienumber idx
+ list-ref d20numbers idx
+
+define : dienumber->cellidx number
+ list-index (λ(x)(= x number)) d20numbers
+
+
+define : latlonsixthslabidx latfromtop lonfrac
+ . "calculate the index in a sixth longitude slab of the icosaeder"
+ ; TODO: use shortest surface distance from center of triangle as faster metric.
+ let*
+ : triangleheight : / (sqrt 3) 2
+ length-top-to-bottom-at-lon0 : + 1 (* 2 triangleheight)
+ height-deg : * 180 : / triangleheight length-top-to-bottom-at-lon0
+ side-deg : * 180 : / 1 length-top-to-bottom-at-lon0
+ ; in one sixth of the icosaeder, there are 6 reachable
+ ; fields. I am indexing them from top to bottom.
+ ; format #t "latfromtop: ~a, lonfrac: ~a, height-deg/3: ~a, side-deg: ~a\n" latfromtop lonfrac (/ height-deg 3) side-deg
+ cond
+ : < latfromtop : / height-deg 3
+ . 0
+ : < latfromtop : - (* 2 (/ height-deg 3)) (* lonfrac (/ height-deg 3))
+ . 0
+ : < latfromtop : * 2 : / height-deg 3
+ . 1
+ : < latfromtop : + (* 2 (/ height-deg 3)) (* lonfrac (* 2 (/ height-deg 3)))
+ . 1
+ : < latfromtop : * 4 : / height-deg 3
+ . 2
+ : < latfromtop : - (+ side-deg (* 2 (/ height-deg 3))) (* lonfrac (- (+ side-deg (* 2 (/ height-deg 3))) (* 4 (/ height-deg 3))))
+ . 2
+ : < latfromtop : + side-deg : * 2 : / height-deg 3
+ . 3
+ : < latfromtop : + (+ side-deg (* 2 (/ height-deg 3))) (* lonfrac (- (+ side-deg (* 4 (/ height-deg 3))) (+ side-deg (* 2 (/ height-deg 3)))))
+ . 3
+ : < latfromtop : - (+ side-deg (* 5 (/ height-deg 3))) (* lonfrac (- (+ side-deg (* 5 (/ height-deg 3))) (+ side-deg (* 4 (/ height-deg 3)))))
+ . 4
+ else
+ . 5
+
define : latlon2cellidx lat lon
- . "Convert a position given as latitude and longitude into the correct cell index."
- ; cell 1 (index 0) is on top, cell 20 at the bottom. The right
- ; border of cell 2 is situated at longitude 0. With that, the
- ; left corner of cell 19 is at longitude 180. Top and bottom
- ; are point-symmetric. We can cleanly divide the upper part of
- ; the icosaeder into 3 regions by longitude. Let's do that.
- let*
- : upper : > lat 0
- ; we start by switching to a symmetric longitude
- slon : if upper lon : + lon 180
- ; the sector number is defined by the uppermost triangle
- ; in it.
- sector : if (< slon 120) 4 (if (< slon 270) 3 2)
+ . "Convert a position given as latitude (-90 .. 90) and
+longitude (0 .. 360) into the correct cell index.
+
+This uses heavy linear approximation."
+ ; FIXME: there is still a bug, as shown in the map plot.
+ ; cell 1 (index 0) is on top, cell 20 at the bottom. The left
+ ; border of cell 2 is situated at longitude 0. We can cleanly
+ ; divide the upper part of the icosaeder into 3 regions by
+ ; longitude. Let's do that.
+ let* ; the sector number is defined by the uppermost triangle
+ : sector : if (< lon 120) 2 (if (< lon 240) 4 3)
; we start by calculating the fraction inside the sector
- lonsectorfraction : modulo slon 120
+ lonsectorfraction : modulo lon 120
; we can further subdivide the sector by longitude into two subsectors
- subseclon : if (< lon 60) lon (-120 lon)
- ; TODO find some more symmetry or start nontrivial geometry.
- . #t
+ subsector : if (< lonsectorfraction 60) 0 1
+ subseclon : if (= subsector 0) lonsectorfraction (- 120 lonsectorfraction)
+ lonfrac : / subseclon 60
+ latfromtop : - 90 lat
+ sixthslab : latlonsixthslabidx latfromtop lonfrac
+ ; for each sector and subsector, set the dienumber
+ slabsec->index '((2 . ((1 14 19 13 15 20) (1 14 16 17 11 20)))
+ (4 . ((1 6 9 3 11 20) (1 6 8 2 7 20)))
+ (3 . ((1 10 4 5 7 20) (1 10 18 12 15 20))))
+ dienumber->cellidx
+ list-ref
+ list-ref
+ assoc-ref slabsec->index sector
+ . subsector
+ . sixthslab
-display : d20-as-text world
-newline
+define : main args
+ . "Test the code"
+ if : > 2 (length args)
+ set! args : append args '("88") ; lat
+ if : > 3 (length args)
+ set! args : append args '("45") ; lon
+ display : latlon2cellidx (string->number (first (take-right args 2))) (string->number (last args))
+ newline
+ display : d20-as-text world
+ newline
+
+ ; format #t "Diffuse ~A\n" 0.01
+ ; d20-diffuse world neighbors 0.01
+ ; display : d20-as-text world
+ ; newline
+ ; format #t "Advect ~A\n" 0.1
+ ; d20-advect world advection-directions 0.1
+ ; display : d20-as-text world
+ ; newline
+ ; format #t "Diffuse ~A\n" 0.1
+ ; d20-diffuse world neighbors 0.1
+ ; display : d20-as-text world
+ ; newline
+ format #t "Diffuse: ~A*(~A)\n" 100 0.1
+ let loop : : steps 100
+ cond
+ : = 0 steps
+ . world
+ else
+ d20-diffuse world neighbors 0.1
+ loop : 1- steps
+ display : d20-as-text world
+ newline
+ let
+ : number 20
+ val 1
+ format #t "disturb: ~A to ~A\n" number val
+ vector-set! world (1- number) val
+ display : d20-as-text world
+ newline
+ ; format #t "Diffuse ~A\n" 0.1
+ ; d20-diffuse world neighbors 0.1
+ ; display : d20-as-text world
+ ; newline
+ ;
+ ; format #t "Advect: ~A*(~A)\n" 1000 0.001
+ ; let loop : : steps 1000
+ ; cond
+ ; : = 0 steps
+ ; . world
+ ; else
+ ; d20-advect world advection-directions 0.001
+ ; display : d20-as-text world
+ ; d20-cursor-up-text world
+ ; loop : 1- steps
+ ; display : d20-as-text world
+ ; newline
+ ; format #t "Diffuse: ~A*(~A)\n" 1000 0.004
+ ; let loop : : steps 1000
+ ; cond
+ ; : = 0 steps
+ ; . world
+ ; else
+ ; d20-diffuse world neighbors 0.004
+ ; display : d20-as-text world
+ ; d20-cursor-up-text world
+ ; loop : 1- steps
+ display : d20-as-text world
+ newline
+ format #t "Diffuse+Advect: ~A*(~A+~A)\n" 500 0.002 0.003
+ let loop : : steps 500
+ cond
+ : = 0 steps
+ . world
+ else
+ d20-diffuse world neighbors 0.002
+ d20-advect world advection-directions 0.003
+ display : d20-as-text world
+ d20-cursor-up-text world
+ loop : 1- steps
+ display : d20-as-text world
+ newline
+
+ let
+ :
+ v
+ let loop
+ : lon 359
+ lat 89
+ map '()
+ zone '()
+ cond
+ : and (= lat -90) (= lon 0)
+ cons : cons (vector-ref world (latlon2cellidx lat lon)) zone
+ . map
+ : = lon 0
+ loop
+ . 359
+ - lat 1
+ cons : cons (vector-ref world (latlon2cellidx lat lon)) zone
+ . map
+ . '()
+ else
+ loop
+ - lon 1
+ . lat
+ . map
+ cons : vector-ref world (latlon2cellidx lat lon)
+ . zone
+ port : open-output-pipe "python"
+ display "a = \"" port
+ write v port
+ display "\"" port
+ newline port
+ display "a = eval(a.replace('(', '[').replace(')', ']').replace(' ',', '))" port
+ newline port
+ display "import numpy as np
+import pylab as pl
+import mpl_toolkits.basemap as bm
+arr = np.array(a)
-format #t "Diffuse ~A\n" 0.01
-d20-diffuse world neighbors 0.01
-display : d20-as-text world
-newline
-format #t "Advect ~A\n" 0.1
-d20-advect world advection-directions 0.1
-display : d20-as-text world
-newline
-format #t "Diffuse ~A\n" 0.1
-d20-diffuse world neighbors 0.1
-display : d20-as-text world
-newline
-format #t "Diffuse: ~A*(~A)\n" 100 0.1
-let loop : : steps 100
- cond
- : = 0 steps
- . world
- else
- d20-diffuse world neighbors 0.1
- loop : 1- steps
-display : d20-as-text world
-newline
-let
- : number 20
- val 1
- format #t "disturb: ~A to ~A\n" number val
- vector-set! world (1- number) val
- display : d20-as-text world
- newline
-format #t "Diffuse ~A\n" 0.1
-d20-diffuse world neighbors 0.1
-display : d20-as-text world
-newline
+m = bm.Basemap(projection='cea', resolution='l', lat_ts=37.5)
+m.drawcoastlines(color='k',linewidth=0.3)
+m.drawmeridians(np.arange(-120.0, 180.0, 60), labels=[0,0,0,1], linewidth=0.15) # , yoffset=6) # labels = [left,right,top,bottom]
+m.drawparallels(np.arange(-60.0, 90.0, 30), labels=[1,0,0,0], linewidth=0.15)
+ny, nx = arr.shape
+lons, lats = pl.meshgrid(range(-nx/2, nx/2 + nx%2),
+ range(-ny/2, ny/2 + ny%2))
+x, y = m(lons, lats)
-format #t "Advect: ~A*(~A)\n" 1000 0.001
-let loop : : steps 1000
- cond
- : = 0 steps
- . world
- else
- d20-advect world advection-directions 0.001
- display : d20-as-text world
- d20-cursor-up-text world
- loop : 1- steps
-display : d20-as-text world
-newline
-format #t "Diffuse: ~A*(~A)\n" 1000 0.004
-let loop : : steps 1000
- cond
- : = 0 steps
- . world
- else
- d20-diffuse world neighbors 0.004
- display : d20-as-text world
- d20-cursor-up-text world
- loop : 1- steps
-display : d20-as-text world
-newline
-format #t "Diffuse+Advect: ~A*(~A+~A)\n" 1000 0.002 0.001
-let loop : : steps 1000
- cond
- : = 0 steps
- . world
- else
- d20-diffuse world neighbors 0.002
- d20-advect world advection-directions 0.001
- display : d20-as-text world
- d20-cursor-up-text world
- loop : 1- steps
-display : d20-as-text world
-newline
-
-; now plot the result
-let : : port : open-output-pipe "python"
- format port "from mpl_toolkits.mplot3d import Axes3D, art3d
-import numpy as np
-import scipy as sp
-from matplotlib import cm
-import matplotlib.pyplot as plt
-from scipy.spatial import Delaunay
-
-def Icosahedron():
- h = 0.5*(1+np.sqrt(5))
- p1 = np.array([[0,1,h],[0,1,-h],[0,-1,h],[0,-1,-h]])
- p2 = p1[:,[1,2,0]]
- p3 = p1[:,[2,0,1]]
- return np.vstack((p1,p2,p3))
-
-Ico = Icosahedron()
-tri = Delaunay(Ico)
-CH = tri.convex_hull
-points = tri.points
-
-fig = plt.figure(figsize=(4.0,4.0))
-ax = fig.add_subplot(111, projection='3d')
-
-print points
-for i in range(points.shape[0]):
- neighbors = tri.neighbors[i,:]
- for n in range(points.shape[0]):
- pts = []
- for u in range(points.shape[0]):
- pt = np.zeros((3,3))
- pt[0,:] = points[(i),:]
- pt[1,:] = points[(n),:]
- pt[2,:] = points[(u),:]
- # print pt
- pt *= 0.5
- pt += 0.5
- pts.append(pt)
- tr = art3d.Poly3DCollection(pts)
- tr.set_color([(0.9*i)/points.shape[0]] + [(0.9*n)/points.shape[0]]*3)
- ax.add_collection3d(tr)
-# ax.plot_surface(x, y, z, color='g')
-
-plt.show()
-
-exit()\n"
- close-pipe port
-
+m.pcolormesh(x, y, arr, cmap=pl.get_cmap('Paired'))
+pl.colorbar()
+pl.show()
+" port
+ close-pipe port
+ newline
+
+
+; ; now plot the result
+; let : : port : open-output-pipe "python"
+; format port "from mpl_toolkits.mplot3d import Axes3D, art3d
+; import numpy as np
+; import scipy as sp
+; from matplotlib import cm
+; import matplotlib.pyplot as plt
+; from scipy.spatial import Delaunay
+;
+; def Icosahedron():
+; h = 0.5*(1+np.sqrt(5))
+; p1 = np.array([[0,1,h],[0,1,-h],[0,-1,h],[0,-1,-h]])
+; p2 = p1[:,[1,2,0]]
+; p3 = p1[:,[2,0,1]]
+; return np.vstack((p1,p2,p3))
+;
+; Ico = Icosahedron()
+; tri = Delaunay(Ico)
+; CH = tri.convex_hull
+; points = tri.points
+;
+; fig = plt.figure(figsize=(4.0,4.0))
+; ax = fig.add_subplot(111, projection='3d')
+;
+; print points
+; for i in range(points.shape[0]):
+; neighbors = tri.neighbors[i,:]
+; for n in range(points.shape[0]):
+; pts = []
+; for u in range(points.shape[0]):
+; pt = np.zeros((3,3))
+; pt[0,:] = points[(i),:]
+; pt[1,:] = points[(n),:]
+; pt[2,:] = points[(u),:]
+; # print pt
+; pt *= 0.5
+; pt += 0.5
+; pts.append(pt)
+; tr = art3d.Poly3DCollection(pts)
+; tr.set_color([(0.9*i)/points.shape[0]] + [(0.9*n)/points.shape[0]]*3)
+; ax.add_collection3d(tr)
+; # ax.plot_surface(x, y, z, color='g')
+;
+; plt.show()
+;
+; exit()\n"
+; close-pipe port
diff --git a/examples/d6.w b/examples/d6.w
--- a/examples/d6.w
+++ b/examples/d6.w
@@ -1,27 +1,42 @@
-#!/home/arne/wisp/wisp-multiline.sh
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples d6) main)' -s "$0" "$@"
; !#
define-module : examples d6
. #:export : roll check
+use-modules : srfi srfi-1
+
; basic d6 rules, implemented in guile
define : roll
. "Roll one ± d6"
- let : : die '(-5 -3 -1 2 4 6)
- list-ref die : random 6 : random-state-from-platform
-
+ let*
+ : eyes '(-5 -3 -1 2 4 6)
+ d6 : lambda () : list-ref eyes : random 6 : random-state-from-platform
+ let rolling : : rolled : cons (d6) '()
+ cond
+ : = 1 (length rolled)
+ if : not : member (first rolled) '(-5, 6)
+ first rolled
+ rolling : cons (d6) rolled
+ : not : equal? (first rolled) (second rolled)
+ apply + : cdr rolled
+ else
+ rolling : cons (d6) rolled
+
+
+
define : check skill target effect-threshold
. "Check whether a given skill-roll succeeds and provide a margin of success."
let : : result : + skill : roll
if : > result target
- if : < effect-threshold : - result target
- . 1
- . #t
+ floor/ {result - target} effect-threshold
. #f
-display : check 12 9 3
-newline
-display : roll
-
-
+define : main args
+ display : check 12 9 3
+ newline
+ newline
+ display : roll
diff --git a/examples/ensemble-estimation.w b/examples/ensemble-estimation.w
--- a/examples/ensemble-estimation.w
+++ b/examples/ensemble-estimation.w
@@ -78,19 +78,31 @@ define* : write-multiple . x
;; Start with the simple case: One variable and independent observations (R diagonal)
;; First define a truth
-define x^seed '(0.5 0.6 7 0.1 0.7 0.9 0.8 0.4)
+define x^seed '(0.5 0.6 2 0.1) ; 0.7 0.9 0.8 0.4)
+;; The size is the length of the seed, squared, each multiplied by each
define x^true : append-ec (: i (length x^seed)) : list-ec (: j x^seed) : * j : list-ref x^seed i
;; And add an initial guess of the parameters
-define x^b : append-ec (: i (length x^seed)) '(1 1 1 1 1 1 1 1) ; initial guess
-define P : make-covariance-matrix-from-standard-deviations : append-ec (: i (length x^seed)) '(0.5 0.1 0.3 0.1 0.2 0.2 0.2 0.2)
+define x^b : append-ec (: i (length x^seed)) '(1 1 1 1) ; 1 1 1 1) ; initial guess
+define P : make-covariance-matrix-from-standard-deviations : append-ec (: i (length x^seed)) '(0.5 0.1 0.3 0.1) ; 0.2 0.2 0.2 0.2)
;; Then generate observations
-define y⁰-num 3000
+define y⁰-num 1000
define y⁰-pos-max 100
;; At the positions where they are measured. Drawn randomly to avoid
;; giving an undue weight to later values.
define y⁰-pos : list-ec (: i y⁰-num) : * (random:uniform) y⁰-pos-max
+define : H-single-parameter xi xi-pos pos
+ . "Observation function for a single parameter."
+ let*
+ : xi-posdist : abs : / {pos - xi-pos} {y⁰-pos-max / 20}
+ cond
+ : < 5 xi-posdist
+ . 0
+ else
+ * xi pos
+ exp : - : expt xi-posdist 2
+
;; We need an observation operator to generate observations from true values
define : H x pos
. "Observation operator. It generates modelled observations from the input.
@@ -103,20 +115,16 @@ x are parameters to be optimized, pos is
x-pos : list-ec (: i len) : * ystretch {{i + 0.5} / {len + 1}}
apply +
list-ec (: i len)
- * : list-ref x i
- . pos
- exp
- -
- expt
- / {pos - (list-ref x-pos i)} {ystretch / 20}
- . 2
-
+ H-single-parameter
+ list-ref x i
+ list-ref x-pos i
+ . pos
;; We start with true observations which we will disturb later to get
;; the equivalent of measured observations
define y^true : list-ec (: i y⁰-pos) : H x^true i
;; now we disturb the observations with a fixed standard deviation. This assumes uncorrelated observations.
-define y⁰-std 50
+define y⁰-std 10
define y⁰ : list-ec (: i y^true) : + i : * y⁰-std : random:normal
;; and define the covariance matrix. This assumes uncorrelated observations.
define R : make-covariance-matrix-from-standard-deviations : list-ec (: i y⁰-num) y⁰-std
@@ -201,21 +209,40 @@ Limitations: y is a single value. R and
define : main args
let*
- : optimized : EnSRT H x^b P y⁰ R y⁰-pos 30
+ : optimized : EnSRT H x^b P y⁰ R y⁰-pos 40
x-opt : list-ref optimized 0
x-deviations : list-ref optimized 1
; std : sqrt : * {1 / {(length x-deviations) - 1}} : sum-ec (: i x-deviations) : expt i 2
- format #t "x⁰: ~A ± ~A\nx: ~A ± ~A\nx^t:~A\ny: ~A ± \ny⁰: ~A ± ~A\nnoise: ~A\n"
+ format #t "x⁰: ~A ± ~A\nx: ~A ± ~A\nx^t: ~A\nx-t/σ:~A\ny̅: ~A ± ~A\ny̅⁰: ~A ± ~A\ny̅^t: ~A\nnoise:~A\n"
. x^b
list-ec (: i (length x^b)) : list-ref (list-ref P i) i
. x-opt
list-ec (: i (length x-opt))
apply standard-deviation-from-deviations : list-ec (: j x-deviations) : list-ref j i
. x^true
+ list-ec (: i (length x-opt))
+ / : - (list-ref x-opt i) (list-ref x^true i)
+ apply standard-deviation-from-deviations : list-ec (: j x-deviations) : list-ref j i
* {1 / (length y⁰)} : apply + : map (lambda (x) (H x-opt x)) y⁰-pos
+ apply standard-deviation-from-deviations
+ append-ec (: i (length x-deviations))
+ let*
+ :
+ x-opt+dev
+ list-ec (: j (length x-opt))
+ + : list-ref x-opt j
+ list-ref
+ list-ref x-deviations i
+ . j
+ y-opt+dev : map (lambda (x) (H x-opt+dev x)) y⁰-pos
+ y-opt : map (lambda (x) (H x-opt x)) y⁰-pos
+ map (lambda (x y) (- x y)) y-opt+dev y-opt
+ ; list-ec (: i (length y-opt))
+ ; - (list-ref y-opt+dev i) (list-ref y-opt i)
; apply standard-deviation-from-deviations : map H x-deviations ; FIXME: This only works for trivial H.
mean y⁰
standard-deviation y⁰
+ * {1 / (length y⁰)} : apply + : map (lambda (x) (H x^true x)) y⁰-pos
. y⁰-std
; now plot the result
let : : port : open-output-pipe "python"
diff --git a/examples/enter-three-witches.w b/examples/enter-three-witches.w
new file mode 100755
--- /dev/null
+++ b/examples/enter-three-witches.w
@@ -0,0 +1,49 @@
+#!/usr/bin/env sh
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples enter-three-witches) main)' -s "$0" "$@"
+; !#
+
+define-module : examples enter-three-witches
+
+use-modules : ice-9 optargs
+
+define-syntax Enter
+ syntax-rules ()
+ : _ (name) b ...
+ begin
+ define-syntax name
+ syntax-rules ::: ()
+ : _ (c :::) d :::
+ format #t "~A\n ~A\n\n"
+ string-join
+ string-split (symbol->string 'name) #\_
+ string-join
+ map : lambda (x) (string-join (map symbol->string x))
+ quote : (c :::) d :::
+ . "\n "
+ : _ c d :::
+ ;; allow for modifier keywords after the name
+ begin
+ format #t "~A:\n" : symbol->string 'c
+ name d :::
+ : _ c :::
+ begin #t c :::
+ Enter b ...
+ : _ b ...
+ begin
+
+
+define : main args
+ Enter : First_Witch
+ Second_Witch
+ Third_Witch
+
+ First_Witch
+ When shall we three meet again
+ In thunder, lightning, or in rain?
+
+ Second_Witch
+ When the hurlyburly's done,
+ When the battle's lost and won.
+
+ Third_Witch
+ That will be ere the set of sun.
diff --git a/examples/factorial.w b/examples/factorial.w
--- a/examples/factorial.w
+++ b/examples/factorial.w
@@ -7,7 +7,7 @@ define-module : examples factorial
define : factorial n ; (define (factorial n)
if : zero? n ; (if (zero? n)
- . n ; => n
+ . 1 ; => 1
* n : factorial {n - 1} ; (* n (factorial {n - 1}))))
define : main args
diff --git a/examples/fib.w b/examples/running_mean_std.w
copy from examples/fib.w
copy to examples/running_mean_std.w
--- a/examples/fib.w
+++ b/examples/running_mean_std.w
@@ -1,81 +1,34 @@
#!/home/arne/wisp/wisp-multiline.sh
; !#
-;; Fibonacci Functions
+use-modules : srfi srfi-11
-define : fibonacci n
- . "Get Fibonacci Element N in Linear Time"
- let rek : (i 0) (u 1) (v 1)
- if : >= i : - n 2
- . v
- rek (+ i 1) v (+ u v) ; else
+define : running-stat-fun
+ let
+ : n 0
+ sum 0
+ sum² 0
+ define : mean-std x
+ set! n : + n 1
+ set! sum : + sum x
+ set! sum² : + sum² : expt x 2
+ let*
+ : mean : / sum n
+ σ
+ - : / sum² n
+ . mean
+ values mean σ
+ . mean-std
-; display : fib 5
+define statfun : running-stat-fun
-;; Try it with curly infix
-
-;; First activate curly infix
-. #!curly-infix
-
-;; Now define fibonacci with curly infix.
-define : fibonacci n
- . "Get Fibonacci Element N in Linear Time"
- let rek : (i 0) (u 1) (v 1)
- if {i >= {n - 2}}
- . v
- rek {i + 1} v {u + v}
-
-display
- . {1 + 1}
+write : statfun 5
newline
-
-;; Due to the compatibility with curly-infix, the following is no longer possible.
-
-;; Try an infix notation with curly brackets - curly infix from readable as simple macro
-;; define-syntax {
-;; syntax-rules : { }
-;; : { left infix right }
-;; infix left right
-;;
-;; ; display : { 1 + 2 }
-;;
-;; ;; Now do the fibonacci again
-;; define : fibcurl n
-;; . "Get Fibonacci Elements in Linear Time"
-;; let rek : (i 0) (u 1) (v 1)
-;; if : { i >= ({ n - 2 }) }
-;; . v
-;; rek ({ i + 1 }) v ({ u + v }) ; else
-;;
-;; ; display : fibcurl 5
-;;
-;; ;; Do a more complete syntax-rule
-;;
-;; ;; Try an infix notation with curly brackets - curly infix from readable as simple macro
-;; define-syntax {
-;; syntax-rules : { }
-;; : { l in r }
-;; in l r
-;; : { { ll lin lr } in r }
-;; in (lin ll lr) r
-;; : { l in { rl rin rr } }
-;; in l (rin rl rr)
-;; : { { ll lin lr } in { rl rin rr } }
-;; in (lin ll lr) (rin rl rr)
-;;
-;; ;; And a complete infix-fibonacci
-;; define : fibcurl2 n
-;; . "Get Fibonacci Elements in Linear Time"
-;; let rek : (i 0) (u 1) (v 1)
-;; if : { i >= { n - 2 } }
-;; . v
-;; rek
-;; { i + 1 }
-;; . v
-;; { u + v }
-;;
-;; ;; But to be frank: Prefix looks better.
-;;
-;; display : { { 1 + 2 } * { 2 * 3 } }
-;; ; display : fibcurl2 5
-;; ; TODO: Make the macro recursive, so it can actually cover arbitrary depths of curly braces.
+write : statfun 4
+newline
+let-values
+ : (mean σ) : statfun 5
+ display mean
+ display '±
+ display σ
+ newline
diff --git a/examples/securepassword.w b/examples/securepassword.w
new file mode 100755
--- /dev/null
+++ b/examples/securepassword.w
@@ -0,0 +1,313 @@
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples securepassword) main)' -s "$0" "$@"
+; !#
+
+;; Create secure passwords, usable on US and German keyboards without problems
+
+;; As of 2011, a single device can do 2,800,000,000 guesses per
+;; second. Today this should be 10 billion guesses per second.
+;; According to a recovery company which sells crackers at 1.5k$, as
+;; of 2016 a zip-file can be attacked with 100,000 guesses per
+;; second. Ars Technica reports 8 billion attacks on md5 on a single
+;; device in 2013[1].
+
+;; Codinghorror quotes[2] codohale[3] on the cost of buying 5 billion
+;; cracked md5 hashes per second in 2010 for just 3$ per hour. This
+;; should be around 20 billion guesses per second today.
+
+;; I will from now on call 20 billion guesses per second for 3$ per
+;; hour the "strong attack" and 100,000 guesses per second the "weak
+;; attack".
+
+;; [1]: http://arstechnica.com/security/2013/05/how-crackers-make-minced-meat-out-of-your-passwords/
+;; [2]: https://blog.codinghorror.com/speed-hashing/
+;; [3]: http://codahale.com/how-to-safely-store-a-password/
+
+;; A password with 8 letters and 1 delimiter (entropy 49) would on
+;; average withstand the strong attack with a single device for 4
+;; hours, so you could buy a cracked md5-secured 8 letter + 1
+;; delimiter password for 12$ (assuming that it was salted, otherwise
+;; you can buy all these md5’ed passwords for around 24$).
+
+;; The 8 letter and 1 delimiter password would withstand the weak
+;; attack until 2031 (when it would be cracked in one year, with a
+;; cost of 26k$), assuming doubling of processing power every two
+;; years. Cracking it in one day would be possible in 2048, paying
+;; just 72$.
+
+;; (yearstillcrackable 49)
+;; => ((in-one-second 64.78071905112638)
+;; (in-one-day 31.983231667249996)
+;; (in-one-year 14.957750741642995))
+
+;; A password with 12 letters and 2 delimiters (length 12, entropy 75)
+;; should withstand the strong attack until 2047 (then it would be
+;; cracked in one year), assuming doubling of processing power every
+;; two years, the weak until 2083.
+
+;; For every factor of 1000 (i.e. 1024 computers), the time to get a
+;; solution is reduced by 20 years. Using every existing cell phone,
+;; the 12 letter key would be cracked by the method with 100,000
+;; guesses per second in 2021 (within one year). Facebook could do
+;; that with Javascript, so you might want to use a longer password if
+;; your data has to be secure against the whole planet for longer than
+;; 5 years.
+
+;; (yearstillcrackable 75 #:guesses/second 1.e5 #:number-of-devices 2.e9)
+;; => ((in-one-second 54.986013343153864)
+;; (in-one-day 22.188525959277467)
+;; (in-one-year 5.163045033670471))
+
+;; Using Landauer’s principle[4], we can estimate the minimum energy
+;; needed to to check a password solution with a computer at room
+;; temperature, assuming that reversible entropy computing isn’t
+;; realized and quantum computers have to stick to Landauer’s limit: A
+;; single bit-flip requires approximately 3 Zeptojoule[5] at room
+;; temperature, so we can flip 333 e18 bits per second with one Watt
+;; of Energy. Processing any information requires at least one
+;; bit-flip. Reducing the temperature to 1.e-7K (reachable with
+;; evaporative cooling) would theoretically allow increasing the bit
+;; flips per Joule to 1e30. That gives a plausible maximum of password
+;; checks per expended energy. Assuming that someone would dedicate a
+;; large nuclear powerplant with 1 Gigawatt of output to cracking your
+;; password, a 160 bit password would withstand the attack for about
+;; 23 years.
+
+;; [4]: https://en.wikipedia.org/wiki/Landauer's_principle
+;; [5]: http://advances.sciencemag.org/content/2/3/e1501492 "DOI: 10.1126/sciadv.1501492"
+
+;; With the password scheme described here, a password with 28 letters
+;; and 6 delimiters (178 bits of entropy) should be secure for almost
+;; 6 million years in the Landauer limit at 1.e-7K, with the energy of
+;; a large nuclear power plant devoted to cracking it.
+
+;; (years-to-crack-landau-limit-evaporative-cooling-nuclear-powerplant 178)
+;; => 6070231.659195759
+
+;; With 24 letters and 5 delimiters it would only last about one
+;; month, though. Mind exponentials and the linear limit of the human
+;; lifespan :)
+
+;; However using the total energy output of the sun (about 0.5e21 W),
+;; a 28 letter, 6 delimiter password would survive for just about 6
+;; minutes. To reach 50 years of password survival against an attacker
+;; harnessing the energy of the sun (a type II civilization on the
+;; Kardashev scale[6] devoting its whole civilization to cracking your
+;; password), you’d need 200 bits of entropy: 32 letters and 7
+;; delimiters. A 36 letter, 8 delimiter password (230 bits of entropy)
+;; would last about 54 billion years. With that it would very likely
+;; outlast that civilization (especially if the civilization devotes
+;; all its power to crack your password) and maybe even its star. They
+;; could in theory just get lucky, though.
+
+;; [6]: https://en.wikipedia.org/wiki/Kardashev_scale
+
+;; An example of a 28 letter, 6 delimiter password would be:
+;; 7XAG,isCF+soGX.f8i6,Vf7P+pG3J!4Xhf
+;; Don’t use this one, though :)
+
+;; If you ever wanted to anger a type II civilization, encrypt their
+;; vital information with a 36 letter, 8 delimiter password like this:
+;; HArw-CUCG+AxRg-WAVN-5KRC*1bRq.v9Tc+SAgG,QfUc
+;; Keep in mind, though, that they might have other means to get it
+;; than brute force. And when they come for you, they will all be
+;; *really angry* :)
+;; Or they might just have developed reversible computing, then all
+;; these computations are just a fun game to stretch the mind :)
+
+
+define-module : examples securepassword
+ . #:export : password yearstillcrackable
+
+import
+ only (srfi srfi-27) random-source-make-integers
+ . make-random-source random-source-randomize!
+ only (srfi srfi-1) second third iota
+ srfi srfi-42
+ ice-9 optargs
+
+
+define : years-to-crack-landau-limit-evaporative-cooling-nuclear-powerplant entropy
+ . "Estimate of the years needed to crack the password in the landauer limit"
+ let*
+ : seconds/day : * 60 60 24
+ days/year 365.25
+ tempK 1e-7
+ room-temp-fraction {tempK / 300}
+ guesses/Joule {1 / {3e-21 * room-temp-fraction}}
+ Gigawatt 1e9
+ guesses/second : * Gigawatt guesses/Joule
+ seconds/day : * 60 60 24
+ days/year 365.25
+ guesses/year : * guesses/second seconds/day days/year
+ / (expt 2 entropy) guesses/year 2
+
+
+define : years-to-crack-landau-limit-evaporative-cooling-draining-a-star entropy
+ . "Estimate of the years needed to crack the password in
+the landauer limit using the whole power output of a
+sun-like star"
+ let*
+ : watt-powerplant 1e9
+ watt-star 0.5e21
+ * : years-to-crack-landau-limit-evaporative-cooling-nuclear-powerplant entropy
+ / watt-powerplant watt-star
+
+
+define* : secondstocrack entropy #:key (guesses/second 100000) (number-of-devices 1)
+ . "Estimate of the seconds it will take to crack the password with the given computing power"
+ / (expt 2 entropy) guesses/second number-of-devices 2
+
+
+define* : hourstocrack entropy #:key . args
+ . "Estimate of the hours it will take to crack the password with the given computing power"
+ let*
+ : seconds/hour : * 60 60
+ / : apply secondstocrack : cons entropy args
+ . seconds/hour
+
+
+define* : daystocrack entropy . args
+ . "Estimate of the days it will take to crack the password with the given computing power"
+ let*
+ : seconds/day : * 60 60 24
+ / : apply secondstocrack : cons entropy args
+ . seconds/day
+
+
+define* : yearstocrack entropy . args
+ . "Estimate of the years it will take to crack the password with the given computing power"
+ let*
+ : days/year 365.25
+ seconds/day : * 60 60 24
+ / : apply secondstocrack : cons entropy args
+ * days/year seconds/day
+
+
+define* : yearstillcrackable entropy #:key (guesses/second 100000) (number-of-devices 1)
+ . "Estimate of the years it will take until the password
+is crackable, assuming a doubling of computing power every
+two years"
+ let
+ : seconds/day : * 60 60 24
+ days/year 365.25
+ `
+ in-one-second
+ , * 2
+ /
+ log : / (expt 2 entropy) (* guesses/second number-of-devices)
+ log 2
+ in-one-day
+ , * 2
+ /
+ log : / (expt 2 entropy) (* seconds/day guesses/second number-of-devices)
+ log 2
+ in-one-year
+ , * 2
+ /
+ log : / (expt 2 entropy) (* days/year seconds/day guesses/second number-of-devices)
+ log 2
+
+
+define : entropy-per-letter lettercount
+ . "calculate the entropy of adding a randomly chosen
+letter from a number of letters equal to LETTERCOUNT"
+ / : log lettercount
+ log 2
+
+
+;; newbase60 without yz_: 55 letters, 5.78 bits of entropy per letter.
+define qwertysafeletters "0123456789ABCDEFGHJKLMNPQRSTUVWXabcdefghijkmnopqrstuvwx"
+;; delimiters: 2.8 bits of entropy per delimiter, in the same place on main keys or the num-pad.
+define delimiters ",.+-*/!"
+
+define random-source : make-random-source
+random-source-randomize! random-source
+
+
+define random-integer
+ random-source-make-integers random-source
+
+
+define : randomletter letters
+ string-ref letters
+ random-integer
+ string-length letters
+
+
+define : flatten e
+ cond
+ : pair? e
+ `
+ ,@ flatten : car e
+ ,@ flatten : cdr e
+ : null? e
+ list
+ else
+ list e
+
+
+define : password/srfi-42 length
+ . "Generate a password with the given length in letters
+(not counting delimiters)."
+ list->string
+ append-ec (: i (iota length 1))
+ cons : randomletter qwertysafeletters
+ if : and (not (= i length)) : zero? : modulo i 4
+ cons : randomletter delimiters
+ list
+ list
+
+
+define : password/map length
+ . "Generate a password with the given length in letters
+(not counting delimiters)."
+ list->string
+ flatten
+ map
+ lambda : i
+ let
+ : letter : randomletter qwertysafeletters
+ if : and (not (= i length)) : zero? : modulo i 4
+ list letter
+ randomletter delimiters
+ list letter
+ iota length 1
+
+
+define : password length
+ . "Generate a password with the given length in letters
+(not counting delimiters)."
+ let fill
+ : letters '()
+ remaining length
+ if : zero? remaining
+ reverse-list->string letters
+ fill
+ cons : randomletter qwertysafeletters
+ if : and (not (= length remaining)) : zero? : modulo remaining 4
+ cons : randomletter delimiters
+ . letters
+ . letters
+ - remaining 1
+
+
+define : main args
+ let
+ :
+ len
+ if : <= 2 : length args
+ string->number : second args
+ . 8
+ let
+ : idx (if (> 3 (length args)) 1 (string->number (third args)))
+ cond
+ : = idx 1
+ display : password len
+ : = idx 2
+ display : password/map len
+ : = idx 3
+ display : password/srfi-42 len
+ newline
+
diff --git a/examples/sh.w b/examples/sh.w
new file mode 100755
--- /dev/null
+++ b/examples/sh.w
@@ -0,0 +1,25 @@
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples sh) main)' -s "$0" "$@"
+; !#
+
+;; simplest way to run shell commands
+
+define-module : examples sh
+ . #:export : sh
+
+use-modules : srfi srfi-1
+
+define : ->string thing
+ if : symbol? thing
+ symbol->string thing
+ format #f "\"~A\"" thing
+
+define : run-me . args
+ system : string-join : map ->string args
+
+define-syntax-rule : sh args ...
+ apply run-me : quote : args ...
+
+define : main args
+ sh echo foo | sed s/o/u/
diff --git a/examples/d6.w b/examples/with.w
copy from examples/d6.w
copy to examples/with.w
--- a/examples/d6.w
+++ b/examples/with.w
@@ -1,27 +1,39 @@
-#!/home/arne/wisp/wisp-multiline.sh
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples with) main)' -s "$0" "$@"
; !#
-define-module : examples d6
- . #:export : roll check
+;; A cleaner way to implement this might be using dynamic-wind.
-; basic d6 rules, implemented in guile
+;; FIXME: This might not be continuation-safe and might break if the
+;; code in the with block uses dynamic-wind. Check whether it’s safe
+;; and fix it if not.
-define : roll
- . "Roll one ± d6"
- let : : die '(-5 -3 -1 2 4 6)
- list-ref die : random 6 : random-state-from-platform
+define-module : examples with
-define : check skill target effect-threshold
- . "Check whether a given skill-roll succeeds and provide a margin of success."
- let : : result : + skill : roll
- if : > result target
- if : < effect-threshold : - result target
- . 1
- . #t
- . #f
+import : oop goops
-display : check 12 9 3
-newline
-display : roll
+define : enter thing
+ . thing
+define-generic enter
+define : exit thing
+ . thing
+define-generic exit
+define-syntax with
+ syntax-rules : as
+ : _ thing as name thunk ...
+ let*
+ : name : enter thing
+ res : begin thunk ...
+ exit thing
+ . res
+
+define-method : exit (thing <port>)
+ . "Ensure that a port is always closed at the end of the with-block."
+ close-port thing
+
+define : main args
+ with (open-file "with.w" "r") as port
+ format #t "~a\n" : read port
diff --git a/tests/fast-sum.scm b/tests/fast-sum.scm
new file mode 100644
--- /dev/null
+++ b/tests/fast-sum.scm
@@ -0,0 +1,16 @@
+(use-modules (srfi srfi-1))
+
+; only for the nice test
+#!curly-infix
+
+(define-syntax fast-sum
+ (syntax-rules (iota)
+ ((fast-sum (iota count start))
+ (+ 1
+ (apply -
+ (map (lambda (x) (/ {x * {x + 1} } 2))
+ (list {count + {start - 1}} start)))))
+ ((fast-sum e)
+ (apply + e))))
+
+
diff --git a/tests/fast-sum.w b/tests/fast-sum.w
new file mode 100644
--- /dev/null
+++ b/tests/fast-sum.w
@@ -0,0 +1,14 @@
+use-modules : srfi srfi-1
+
+; only for the nice test
+. #!curly-infix
+
+define-syntax fast-sum
+ syntax-rules : iota
+ : fast-sum : iota count start
+ + 1
+ apply -
+ map : lambda (x) : / {x * {x + 1} } 2
+ list {count + {start - 1}} start
+ : fast-sum e
+ apply + e
diff --git a/tests/hello.scm b/tests/hello.scm
--- a/tests/hello.scm
+++ b/tests/hello.scm
@@ -1,4 +1,5 @@
(define (hello who)
+ ;; include the newline
(format #t "~A ~A!\n"
"Hello" who))
(hello "Wisp")
diff --git a/tests/hello.w b/tests/hello.w
--- a/tests/hello.w
+++ b/tests/hello.w
@@ -1,4 +1,5 @@
define : hello who
+ ;; include the newline
format #t "~A ~A!\n"
. "Hello" who
hello "Wisp"
diff --git a/tests/multiline-string.scm b/tests/multiline-string.scm
new file mode 100644
--- /dev/null
+++ b/tests/multiline-string.scm
@@ -0,0 +1,6 @@
+(display "
+ This is a
+ \"multi-line\"
+ string.
+ ")
+
diff --git a/tests/multiline-string.w b/tests/multiline-string.w
new file mode 100644
--- /dev/null
+++ b/tests/multiline-string.w
@@ -0,0 +1,5 @@
+display "
+ This is a
+ \"multi-line\"
+ string.
+ "
diff --git a/wisp-guile.w b/wisp-guile.w
--- a/wisp-guile.w
+++ b/wisp-guile.w
@@ -134,8 +134,8 @@ Ends with three consecutive linebreaks o
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
+ ; if all backslashes before the lastchar are paired, the final quote is escaped.
+ not : 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
diff --git a/wisp-mode.el b/wisp-mode.el
--- a/wisp-mode.el
+++ b/wisp-mode.el
@@ -1,9 +1,11 @@
;;; wisp-mode.el --- Tools for wisp: the Whitespace-to-Lisp preprocessor
-;; Copyright (C) 2013 Arne Babenhauserheide <arne_bab@web.de>
+;; Copyright (C) 2013--2016 Arne Babenhauserheide <arne_bab@web.de>
+;; Copyright (C) 2015--2016 Kevin W. van Rooijen — indentation and tools
+;; from https://github.com/kwrooijen/indy/blob/master/indy.el
;; Author: Arne Babenhauserheide <arne_bab@web.de>
-;; Version: 0.2.1
+;; Version: 0.2.3
;; Keywords: languages, lisp
;; This program is free software; you can redistribute it and/or
@@ -28,8 +30,9 @@
;;
;; For details on wisp, see
;; http://draketo.de/light/english/wisp-lisp-indentation-preprocessor
-;;
-;; If you came here looking for wisp the lisp-to-javascript compiler[1], have a look at wispjs-mode[2].
+;;
+;; If you came here looking for wisp the lisp-to-javascript
+;; compiler[1], have a look at wispjs-mode[2].
;;
;; [1]: http://jeditoolkit.com/try-wisp
;;
@@ -70,7 +73,7 @@
; note: for easy testing: emacs -Q wisp-mode.el -e eval-buffer wisp-guile.w -e delete-other-windows
-(defvar wisp-builtin '("define" "define-syntax" "syntax-rules" "defun" "let*" "let" "setq" "set!" "set" "if" "when" "while" "set!" "and" "or" "not" "char=?"))
+(defvar wisp-builtin '("define" "define-syntax" "syntax-rules" "syntax-case" "define-syntax-rule" "defun" "let*" "let" "setq" "set!" "set" "if" "when" "while" "set!" "and" "or" "not" "char=?"))
; TODO: Add special treatment for defun foo : bar baz ⇒ foo = function, bar and baz not.
; TODO: Add highlighting for `, , and other macro-identifiers.
@@ -107,6 +110,93 @@
(" : \\| \\. " . font-lock-keyword-face) ; leading : or .
))
"Default highlighting expressions for wisp mode.")
+(defun wisp--prev-indent ()
+ "Get the amount of indentation spaces if the previous line."
+ (save-excursion
+ (previous-line 1)
+ (while (wisp--line-empty?)
+ (previous-line 1))
+ (back-to-indentation)
+ (current-column)))
+
+(defun wisp--line-empty? ()
+ "Check if the current line is empty."
+ (string-match "^\s*$" (wisp--get-current-line)))
+
+(defun wisp--get-current-line ()
+ "Get the current line as a string."
+ (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+
+(defun wisp--current-indent ()
+ "Get the amount of indentation spaces if the current line."
+ (save-excursion
+ (back-to-indentation)
+ (current-column)))
+
+(defun indy--fix-num (num)
+ "Make sure NUM is a valid number for calculating indentation."
+ (cond
+ ((not num) 0)
+ ((< num 0) 0)
+ (t num)))
+
+(defun wisp--indent (num)
+ "Indent the current line by the amount of provided in NUM."
+ (unless (equal (wisp--current-indent) num)
+ (let* ((num (max num 0))
+ (ccn (+ (current-column) (- num (wisp--current-indent)))))
+ (indent-line-to num)
+ (move-to-column (indy--fix-num ccn)))))
+
+;;;###autoload
+(defun wisp--tab ()
+ "Cycle through indentations depending on the previous line."
+ (interactive)
+ (let* ((curr (wisp--current-indent))
+ (prev (wisp--prev-indent))
+ (width (cond
+ ((< curr (- prev tab-width)) (- prev tab-width))
+ ((< curr prev) prev)
+ ((equal curr prev) (+ prev tab-width))
+ (t 0))))
+ (wisp--indent width)))
+
+
+(defun wisp-indent-current-line (&optional unindented-ok)
+ "Sets the indentation of the current line. Derived from
+indent-relative."
+ (interactive "P")
+ (let ((start-column (current-column))
+ indent)
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-backward "^[^\n]" nil t)
+ (let ((end (save-excursion (forward-line 1) (point))))
+ (setq tab-width 4)
+ (move-to-column start-column)
+ ; TODO: If the previous line is less indented by exactly 4
+ ; characters, de-dent to previous-line minus 4. If the
+ ; previous line is more indented, indent to the
+ ; indentation of the previous line. If both lines are
+ ; equally indented, indent to either the previous line
+ ; plus 4, or to the first occurence of a colon, if that’s
+ ; less.
+ (cond
+ ((= (current-column) (- start-column 4))
+ (setq indent (- (current-column) 4))))
+
+ (or (looking-at "[ \t]")
+ unindented-ok
+ (skip-chars-forward "^ \t" end))
+ (skip-chars-forward " \t" end)
+ (or (= (point) end) (setq indent (current-column))))))
+ (if indent
+ (let ((opoint (point-marker)))
+ (indent-to indent 0)
+ (if (> opoint (point))
+ (goto-char opoint))
+ (move-marker opoint nil))
+ (tab-to-tab-stop))))
; use this mode automatically
;;;###autoload
@@ -123,7 +213,7 @@
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'font-lock-defaults) wisp-font-lock-keywords)
(set (make-local-variable 'mode-require-final-newline) t)
- (local-set-key (kbd "<tab>") 'indent-relative))
+ (local-set-key (kbd "<tab>") 'wisp--tab))
diff --git a/wisp-multiline.sh b/wisp-multiline.sh
--- a/wisp-multiline.sh
+++ b/wisp-multiline.sh
@@ -1,4 +1,4 @@
-#!/bin/bash
+#!/usr/bin/env bash
# wisp-multiline.sh --- run multiline wisp code
# Copyright (C) 2013 Arne Babenhauserheide <arne_bab@web.de>
diff --git a/wisp-reader.w b/wisp-reader.w
--- a/wisp-reader.w
+++ b/wisp-reader.w
@@ -53,7 +53,7 @@ define : read-one-wisp-sexp port env
define-language wisp
. #:title "Wisp Scheme Syntax. See SRFI-119 for details. THIS IS EXPERIMENTAL, USE AT YOUR OWN RISK"
; . #:reader read-one-wisp-sexp
- . #:reader : lambda (port env) : let ((x (read-one-wisp-sexp port env))) x
+ . #:reader read-one-wisp-sexp ; : lambda (port env) : let ((x (read-one-wisp-sexp port env))) (display x)(newline) x ;
. #:compilers `((tree-il . ,compile-tree-il))
. #:decompilers `((tree-il . ,decompile-tree-il))
. #:evaluator : lambda (x module) : primitive-eval x
diff --git a/wisp-repl-guile.sh b/wisp-repl-guile.sh
--- a/wisp-repl-guile.sh
+++ b/wisp-repl-guile.sh
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/usr/bin/env bash
# if the spec file does not exist yet, run the build chain
if test ! -f language/wisp/spec.scm; then
diff --git a/wisp-scheme.w b/wisp-scheme.w
--- a/wisp-scheme.w
+++ b/wisp-scheme.w
@@ -7,15 +7,10 @@ exec guile -L . --language=wisp -s "$0"
;; 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.
+;; Limitations:
+;; - only unescapes up to 6 leading underscores at line start (\______)
+;; - in some cases the source line information is missing in backtraces.
+;; check for set-source-property!
;; Copyright (C) Arne Babenhauserheide (2014--2015). All Rights Reserved.
@@ -613,6 +608,16 @@ define : wisp-unescape-underscore-and-co
map wisp-unescape-underscore-and-colon a
'\_
. '_
+ '\__
+ . '__
+ '\___
+ . '___
+ '\____
+ . '____
+ '\_____
+ . '_____
+ '\______
+ . '______
'\:
. ':
a
@@ -638,6 +643,8 @@ define : wisp-replace-paren-quotation-re
append
map wisp-replace-paren-quotation-repr a
list : list 'quote : map wisp-replace-paren-quotation-repr b
+ : 'REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd 'REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...
+ list 'quasiquote : list 'unquote : map wisp-replace-paren-quotation-repr a
: 'REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...
list 'unquote : map wisp-replace-paren-quotation-repr a
: a ... 'REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b