merge wisp 1.0.3
- provide wisp script that wraps guile --language=wisp -x .w
- add Guile 3.0 to supported versions
- fix documentation: wisp allows up to 12 underscores
- new examples: heapsort, first guile-gi window, triangle, graph-algorithms (bfs),
- improved examples: faster securepassword, fix benchmarks for Python3, enter-three-witches.scm (theater scripts in Scheme), d6, evaluate-r7rs-benchmarks (csv output), download-mesh, upload-server
- download-mesh continues in its own project as wispserve: https://hg.sr.ht/~arnebab/wispserve
- You can create wisp-projects with conf via conf new -l wisp PROJNAME. See https://hg.sr.ht/~arnebab/conf
- wisp moved to sourcehut: https://hg.sr.ht/~arnebab/wisp

wisp-mode 0.2.6
- remove unnecessary autoloads

ob-wisp 0.1
- initial Org-Babel support for evaluating wisp source code in Emacs Org mode
M Makefile.am +5 -2
@@ 4,7 4,7 @@ 
 SUFFIXES = .w .scm .sh
 
 # define the programs to install
-bin_SCRIPTS = wisp2lisp
+bin_SCRIPTS = wisp2lisp wisp
 
 # where to install guile modules to import
 # nobase_ as prefix prevents stripping leading directories

          
@@ 26,7 26,7 @@ WISP = wisp-guile.w wisp-reader.w wisp-s
 guile_install_go_files = install-nobase_goDATA
 $(guile_install_go_files): install-nobase_siteDATA
 
-EXTRA_DIST = $(WISP) bootstrap.sh bootstrap-reader.sh language examples tests wisp-repl-guile.sh testrunner.w wisp.py wisp.scm m4 ob-wisp.el wisp-mode.el AUTHORS.in
+EXTRA_DIST = $(WISP) bootstrap.sh bootstrap-reader.sh language examples tests wisp-repl-guile.sh testrunner.w wisp.py wisp.scm wisp.in m4 ob-wisp.el wisp-mode.el AUTHORS.in
 CLEANFILES = 1 2 $(GOBJECTS)
 DISTCLEANFILES = $(bin_SCRIPTS) $(nobase_site_DATA)
 # don't spout out lots of stuff at each distcheck. Disable for debugging.

          
@@ 39,6 39,9 @@ AM_DISTCHECK_CONFIGURE_FLAGS="--quiet"
 wisp2lisp: wisp.scm ## build only the wisp2lisp converter
 	cp $< $@
 
+wisp: wisp.in ## build only the wisp runner script
+	cp $< $@
+
 .INTERMEDIATE: .mydatastuff
 $(nobase_site_DATA): .wispbootstrap
 .wispbootstrap : ${WISP} wisp.scm

          
M NEWS +22 -0
@@ 1,3 1,25 @@ 
+wisp 1.0.3
+- provide wisp script that wraps guile --language=wisp -x .w
+- add Guile 3.0 to supported versions
+- fix documentation: wisp allows up to 12 underscores
+- new examples: heapsort, first guile-gi window, triangle, graph-algorithms (bfs), 
+- improved examples: faster securepassword, fix benchmarks for Python3, enter-three-witches.scm (theater scripts in Scheme), d6, evaluate-r7rs-benchmarks (csv output), download-mesh, upload-server
+- download-mesh continues in its own project as wispserve: https://hg.sr.ht/~arnebab/wispserve
+- You can create wisp-projects with conf via `conf new -l wisp PROJNAME`. See https://hg.sr.ht/~arnebab/conf
+- wisp moved to sourcehut: https://hg.sr.ht/~arnebab/wisp
+
+wisp-mode 0.2.6
+- remove unnecessary autoloads
+
+ob-wisp 0.1
+- initial Org-Babel support for evaluating wisp source code in Emacs Org mode
+
+wisp-mode 0.2.5
+- backtab chooses existing lower indentation values from previous lines.
+
+wisp-mode 0.2.4
+- improve tabbing behaviour
+
 wisp 1.0.2
 - guild compile is missing the load path
 

          
M configure.ac +2 -2
@@ 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], [1.0.2],
+AC_INIT([wisp], [1.0.3],
         [arne_bab@web.de])
 # Add macros in m4/ to ensure that wisp builds without having Guile in the aclocal path
 AC_CONFIG_MACRO_DIR([m4])

          
@@ 12,7 12,7 @@ AC_CANONICAL_TARGET
 # 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_PKG([3.0 2.2 2.0 1.8])
 GUILE_PROGS
 GUILE_SITE_DIR
 

          
M examples/benchmark.w +13 -20
@@ 22,6 22,12 @@ import : statprof
          system vm program
 
 
+;; Define targets for the data aquisition
+define max-relative-uncertainty 0.3 ;; 3 sigma from 0
+define max-absolute-uncertainty-seconds 1.e-3 ;; 1ms, required to ensure that the model uses the higher values (else they would have huge uncertainties). If you find you need more, use a smaller test case.
+define min-aggregated-runtime-seconds 1.e-5 ;; 10μs ~ 30k cycles
+define max-iterations 32 ;; at most 128 samples, currently corresponding to at least 1ms each, so a benchmark of a fast function should take at most 0.1 seconds.
+
 
 ;; stddev from rosetta code: http://rosettacode.org/wiki/Standard_deviation#Scheme
 define : stddev nums

          
@@ 70,12 76,6 @@ define* : benchmark-run-single fun #:key
             /  seconds loop-num ;; this wastes less than {(4 * ((4^(i-1)) - 1)) / 4^i} fractional data but gains big in simplicity
             profiler (* 4 loop-num) ;; for fast functions I need to go up rapidly, for slow ones I need to avoid overshooting
 
-;; Define targets for the data aquisition
-define max-relative-uncertainty 0.3 ;; 3 sigma from 0
-define max-absolute-uncertainty-seconds 1.e-3 ;; 1ms, required to ensure that the model uses the higher values (else they would have huge uncertainties). If you find you need more, use a smaller test case.
-define min-aggregated-runtime-seconds 1.e-5 ;; 10μs ~ 30k cycles
-define max-iterations 128 ;; at most 128 samples, currently corresponding to at least 1ms each, so a benchmark of a fast function should take at most 0.1 seconds.
-
 define* : benchmark-run fun
     ;; pretty-print fun
     let lp : (min-seconds min-aggregated-runtime-seconds) (sampling-steps 8) ;; start with at least 3 sampling steps to make the approximations in stddev-unbiased-normal good enough

          
@@ 207,13 207,6 @@ define : bench-set param-list
             benchmark (list-set! a b #t) :let ((a (iota (max N m)))(b (- m 1)))
   zip param-list : map f param-list
 
-define : bench-copy param-list
-  . "Copy a list of length N."
-  define : f x
-     let : (N (list-ref x 0)) (m (list-ref x 1))
-            benchmark (set! b (list-copy a)) :let ((a (iota N))(b #f))
-  zip param-list : map f param-list
-
 define : bench-getslice-left param-list
   . "Get a slice from left."
   define : f x

          
@@ 497,9 490,7 @@ define* : plot-benchmark-result bench H 
         format #t "Model standard deviation (uncertainty): ~,4e\n" y-std
         newline
         ; now plot the result
-        let : : port : open-output-pipe "python2"
-          format port "# encoding: utf-8\n"
-          format port "from __future__ import unicode_literals\n"
+        let : : port : open-output-pipe "python3"
           format port "import pylab as pl\nimport matplotlib as mpl\n"
           format port "y0 = [float(i) for i in '~A'[1:-1].split(' ')]\n" y⁰
           format port "ystds = [float(i) for i in '~A'[1:-1].split(' ')]\n" y⁰-stds

          
@@ 510,10 501,10 @@ define* : plot-benchmark-result bench H 
           format port "yopt = [float(i) for i in '~A'[1:-1].split(' ')]\n" : list-ec (: i y⁰-pos) : H x-opt i
           format port "yoptstds = [float(i) for i in '~A'[1:-1].split(' ')]\n" y-stds
           ;; format port "pl.errorbar(*zip(*sorted(zip(ypos1, yinit))), yerr=zip(*sorted(zip(ypos1, yinitstds)))[1], label='prior vs N')\n"
-          format port "pl.errorbar(*zip(*sorted(zip(ypos1, yopt))), yerr=zip(*sorted(zip(ypos1, yoptstds)))[1], marker='H', mew=1, ms=10, linewidth=0.1, label='optimized vs N')\n"
+          format port "pl.errorbar(*zip(*sorted(zip(ypos1, yopt))), yerr=list(zip(*sorted(zip(ypos1, yoptstds))))[1], marker='H', mew=1, ms=10, linewidth=0.1, label='optimized vs N')\n"
           format port "eb=pl.errorbar(*zip(*sorted(zip(ypos1, y0))), yerr=ystds, alpha=0.6, marker='x', mew=2, ms=10, linewidth=0, label='measurements vs N')\neb[-1][0].set_linewidth(1)\n"
-          ;; format port "pl.errorbar(*zip(*sorted(zip(ypos2, yinit))), yerr=zip(*sorted(zip(ypos2, yinitstds)))[1], label='prior vs. m')\n"
-          format port "pl.errorbar(*zip(*sorted(zip(ypos2, yopt))), yerr=zip(*sorted(zip(ypos2, yoptstds)))[1], marker='h', mew=1, ms=10, linewidth=0.1, label='optimized vs. m')\n"
+          ;; format port "pl.errorbar(*zip(*sorted(zip(ypos2, yinit))), yerr=list(zip(*sorted(zip(ypos2, yinitstds))))[1], label='prior vs. m')\n"
+          format port "pl.errorbar(*zip(*sorted(zip(ypos2, yopt))), yerr=list(zip(*sorted(zip(ypos2, yoptstds))))[1], marker='h', mew=1, ms=10, linewidth=0.1, label='optimized vs. m')\n"
           format port "eb=pl.errorbar(*zip(*sorted(zip(ypos2, y0))), yerr=ystds, alpha=0.6, marker='x', mew=2, ms=10, linewidth=0, label='measurements vs. m')\neb[-1][0].set_linewidth(1)\n"
           format port "pl.plot(sorted(ypos1+ypos2), pl.log(sorted(ypos1+ypos2))*(max(y0) / pl.log(max(ypos1+ypos2))), label='log(x)')\n"
           format port "pl.plot(sorted(ypos1+ypos2), pl.sqrt(sorted(ypos1+ypos2))*(max(y0) / pl.sqrt(max(ypos1+ypos2))), label='sqrt(x)')\n"

          
@@ 579,10 570,12 @@ define : main args
                       if (equal? dN 0) N "N"
                       if (equal? dm 0) m "m"
               define : filename identifier
-                  format #f "/tmp/benchmark-~a-~a-~a.png"
+                  format #f "/tmp/benchmark-~a--~a-~a--~a-~a.png"
                       . identifier
                       if (equal? dN 0) N "N"
+                      . dN
                       if (equal? dm 0) m "m"
+                      . dm
               pbr (bench-operation-+ param-list) H
                   . #:title : title "+ N m"
                   . #:filename : filename "operation-plus"

          
M examples/d6.scm +4 -5
@@ 19,14 19,13 @@ 
         (let rolling ((rolled (cons (d6) '())))
             (cond
               ((= 1 (length rolled))
-                (if (not (member (first rolled) '(-5, 6)))
-                     (first rolled)
+                (if (not (member (first rolled) '(-5 6)))
+                     (values (first rolled) (first rolled))
                      (rolling (cons (d6) rolled))))
               ((not (equal? (first rolled) (second rolled)))
-                (apply + (cdr rolled)))
+                (values (apply + (cdr rolled)) (first rolled)))
               (else
-                (rolling (cons (d6) rolled)))))))
-                
+                (rolling (cons (d6) rolled)))))))                
                 
           
 (define (check skill target effect-threshold)

          
M examples/d6.w +7 -3
@@ 19,11 19,15 @@ define : roll
         let rolling : : rolled : cons (d6) '()
             cond
               : = 1 (length rolled)
-                if : not : member (first rolled) '(-5, 6)
-                     first rolled
+                if : not : member (first rolled) '(-5 6)
+                     values
+                         first rolled
+                         first rolled
                      rolling : cons (d6) rolled
               : not : equal? (first rolled) (second rolled)
-                apply + : cdr rolled
+                values
+                    apply + : cdr rolled
+                    first rolled
               else
                 rolling : cons (d6) rolled
                 

          
M examples/doctests.scm +4 -3
@@ 38,9 38,10 @@ exec guile -L $(dirname $(dirname $(real
 ;;     #((tests (test-eqv 'A (A))))
 ;;     #f)
 
-;; With wisp, you currently need to use the literal #((tests (...)))
-;; TODO: add array parsing to wisp following quoting with ':
-;;       # a b → #(a b) and # : a b c → #((a b))
+;; With wisp, you currently need to use the literal
+;; ##
+;;    tests
+;;        test-equal ...
 
 
 (define-module (examples doctests)

          
M examples/doctests.w +4 -3
@@ 39,9 39,10 @@ exec -a "$0" guile -L $(dirname $(dirnam
 ;;     #((tests (test-eqv 'A (A))))
 ;;     #f)
 
-;; With wisp, you currently need to use the literal #((tests (...)))
-;; TODO: add array parsing to wisp following quoting with ':
-;;       # a b → #(a b) and # : a b c → #((a b))
+;; With wisp, you currently need to use the literal
+;; ##
+;;    tests
+;;        test-equal ...
 
 
 define-module : examples doctests

          
A => examples/doctestss-testone.scm +12 -0
@@ 0,0 1,12 @@ 
+#!/usr/bin/env sh
+exec guile -L $(dirname $(dirname $(realpath "$0"))) -s "$0" "$@"
+; !#
+
+(import (examples doctests))
+
+(define (one)
+    "(test 'one
+        (test-equal 1 (one)))"
+    1)
+
+(doctests-testmod (current-module))

          
A => examples/downloadmesh.scm +202 -0
@@ 0,0 1,202 @@ 
+#!/usr/bin/env bash
+(# -*- wisp -*-)
+(exec -a "$0" guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -x .w -e '(examples downloadmesh)' -c '' "$@")
+; !#
+
+;;; downloadmesh --- multi-source swarming downloads via HTTP
+
+;; This follows the Gnutella download mesh, and adds a parity option
+;; to compensate variable upload speeds by clients.
+
+;; Download mesh specification:
+;; http://rfc-gnutella.sourceforge.net/developer/tmp/download-mesh.html
+
+(define-module (examples downloadmesh)
+              #:export (main serve download-file))
+
+(import
+    (only (srfi srfi-27) random-source-make-integers
+      make-random-source random-source-randomize!)
+    (only (srfi srfi-1) first second third iota)
+    (srfi srfi-11 );; let-values
+    (srfi srfi-42)
+    (srfi srfi-1 );; list operations
+    (ice-9 optargs)
+    (ice-9 format)
+    (ice-9 match)
+    (ice-9 threads)
+    (ice-9 pretty-print)
+    (ice-9 binary-ports)
+    ;; fibers web server ;; using fibers, mind the different arguments of run-server!
+    (web server );; standard Guile server, mind the different arguments of run-server!
+    (web client)
+    (web request)
+    (web response)
+    (web uri)
+    (ice-9 iconv );; bytevector->string
+    (ice-9 ftw ); file tree walk
+    (only (web http) declare-opaque-header!)
+    (examples doctests))
+
+(define xalt (list ));; per file: (hash IP)
+(define xnalt (list ));; per file: (hash IP)
+(define (assoc-item l k)
+    (assoc k l))
+(define hashes (list ));; (filename hash)
+
+(define (declare-download-mesh-headers!)
+    ;; TODO: add validation to the header instead of giving them as opaque strings
+    (declare-opaque-header! "X-Alt" );; good sources, list of IP:port, separated by commas. Default port 6346 may be omitted.
+    (declare-opaque-header! "X-NAlts" );; bad sources, list of IP:port, separated by commas
+    (declare-opaque-header! "X-Gnutella-Content-URN"))
+
+
+(define (download-file url)
+    (let*
+        ((uri (string->uri-reference url))
+          (headers `((range bytes (0 . #f))) ));; minimal range header so that the server can serve a content range
+        (display uri)
+        (newline)
+        (let-values (((resp body) (http-get uri #:headers headers)))
+          (pretty-print resp)
+          (pretty-print (if (string? body) body (bytevector->string body "ISO-8859-1"))))))
+
+
+(define (list-files files-path)
+  (let*
+      ((files (scandir files-path))
+        (file-list
+          (if (not files)
+            (begin (mkdir files-path)
+                    (list "." ".."))
+            (map (λ(x) (string-append "<li><a href=\"files/" x "\">" x "</a></li>\n"))
+                files))))
+      (string-join
+        (append
+          (list "<!DOCTYPE html><html><head><title>Files</title></head><body><h2>Upload</h2><form action='/upload' method='POST' enctype='multipart/form-data'>
+    <input type='file' name='img' multiple />
+    <input type='submit' value='Upload' />
+</form><h2>Files</h2><ul>")
+          file-list
+          (list "</ul></body></html>\n")))))
+
+
+(define (get-file-chunk abspath begin end)
+    "open the file, seek to BEGIN, return bytearray from BEGIN to END"
+    (if (not (file-exists? abspath))
+       ""
+       (let ((port (open-input-file abspath #:binary #t)))
+         (seek port begin SEEK_SET)
+         (let ((data (if end (get-bytevector-n port (- end begin)) (get-bytevector-all port))))
+           (close port)
+           (pretty-print (list abspath begin end data))
+           (if (eof-object? data)
+              ""
+              (bytevector->string data "ISO-8859-1"))))))
+
+(define (join-path-elements-safely path-elements)
+    "Remove every .. and / from the path elements and join as path"
+    (string-join
+        (remove (λ (x) (or (equal? x "..") (equal? x "/")))
+            path-elements)
+        "/" ));; TODO: make platform independent
+
+(define (server-serve-file folder-path range begin-end path)
+   (let*
+       ((abspath (string-join (list folder-path path) "/"))
+         (data (get-file-chunk abspath (car begin-end) (cdr begin-end))))
+       (values
+          (build-response
+            #:headers `((content-type . (application/octet-stream))
+                          (accept-ranges . (bytes))
+                          (X-Alt . ,(string-join (remove not (map second xalt)) ",")))
+            #:code (if range 206 200))
+          data)))
+
+(define (server-list-files folder-path)
+       (values
+          (build-response 
+            #:headers `((content-type . (text/html))
+                          (accept-ranges . (bytes))))
+          (list-files folder-path)))
+
+
+(define (server-file-download-handler folder-path request body)
+    ;; TODO: serve range requests, see https://developer.mozilla.org/en-US/docs/Web/HTTP/Range_requests
+    ;; TODO: return status code 206 for range requests (also for initial?): https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/206
+    (let*
+        ((headers (request-headers request))
+          (range (assoc-item headers 'range))
+          (begin-end
+              (if (or (not range) {(length range) < 3})
+                 '(0 . #f)
+                 (third range)))
+          (path-elements (split-and-decode-uri-path (uri-path (request-uri request))))
+          (path (join-path-elements-safely path-elements))
+          (peer (getpeername (request-port request)))
+          (ip (sockaddr:addr peer))
+          (port (sockaddr:port peer))
+          (ipv4 (inet-ntop AF_INET ip)))
+          ;; ipv6 : inet-ntop AF_INET6 peer
+        (pretty-print xalt)
+        (cond
+            ((null? path-elements)
+              (server-list-files folder-path))
+            (else
+              (set! xalt (alist-cons path (cons ipv4 (if (assoc-ref xalt path) (assoc-ref xalt path) (list))) xalt))
+              (server-serve-file folder-path range begin-end path)))))
+
+(define (serve folder-path)
+    (define (handler-with-path request body)
+        (server-file-download-handler folder-path request body))
+    (define s
+        (socket AF_INET SOCK_STREAM 0))
+    (setsockopt s SOL_SOCKET SO_REUSEADDR 1)
+    
+    ;; fibers server
+    (format (current-error-port)
+           "Serving files on http://[::1]:~d\n" 8083)
+    ;; run-server handler-with-path #:family AF_INET #:port 8083 #:addr INADDR_ANY
+    ;; run-server handler-with-path #:family AF_INET6 #:port 8083 #:addr (inet-pton AF_INET6 "::") #:socket (socket AF_INET6 SOCK_STREAM 0)
+    ;; standard server
+    ;; IPv4
+    (run-server handler-with-path 'http `(#:host "localhost" #:family ,AF_INET #:addr ,INADDR_ANY #:port 8083) ));  #:socket ,s)
+    ;; IPv6
+    ;; run-server handler-with-path 'http `(#:family ,AF_INET6 #:addr (inet-pton AF_INET6 "::") #:port 8083 #:socket ,(socket AF_INET6 SOCK_STREAM 0))
+
+(define (help-message args)
+       #(
+         (tests
+             (test-assert (string-contains (help-message '("./program")) "./program"))
+             (test-equal #\U (string-ref (help-message '("./program")) 0))))
+       (format #f "Usage: ~a [options]
+
+Options:
+   [link [link ...]] download file(s)
+   --serve <folder>  serve the files in FOLDER
+   --help            show this message
+   --test            run unit tests
+" (first args)))
+
+(define (help args)
+       (display (help-message args)))
+
+(define %this-module (current-module))
+(define (test)
+         (doctests-testmod %this-module))
+
+(define (main args)
+   (declare-download-mesh-headers!)
+   (let ((arguments (cdr args)))
+     (cond
+       ((or (null? arguments) (member "--help" arguments) (member "-h" arguments))
+         (help args))
+       ((member "--test" arguments)
+         (test))
+       ((and {(length arguments) > 1} (equal? "--serve" (car arguments)))
+         (serve (second arguments)))
+       (else
+         (download-file (car arguments))))))
+
+
+

          
M examples/downloadmesh.w +276 -39
@@ 1,5 1,9 @@ 
 #!/usr/bin/env bash
 # -*- wisp -*-
+function die () {
+    echo $1 && exit 1 
+}
+guile -c '(import (fibers web server))' || die "ERROR: cannot import fibers, exiting"
 guile -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp) (language wisp spec))'
 exec -a "$0" guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -x .w -e '(examples downloadmesh)' -c '' "$@"
 ; !#

          
@@ 43,6 47,7 @@ import
     srfi srfi-11 ;; let-values
     srfi srfi-42
     srfi srfi-1 ;; list operations
+    only (srfi srfi-27) random-integer
     only (srfi srfi-9) define-record-type
     only (ice-9 popen) open-input-pipe
     only (ice-9 rdelim) read-string

          
@@ 52,8 57,8 @@ import
     ice-9 threads
     ice-9 pretty-print
     ice-9 binary-ports
-    fibers web server ;; using fibers, mind the different arguments of run-server!
-    ;; web server ;; standard Guile server, mind the different arguments of run-server!
+    prefix (fibers web server) fibers: ;; using fibers, mind the different arguments of run-server!
+    web server ;; standard Guile server, mind the different arguments of run-server!
     web client
     web request
     web response

          
@@ 65,7 70,34 @@ import
     only (web http) declare-opaque-header!
     examples doctests
     only (oop goops) define-generic define-method <string>
-    only (rnrs bytevectors) bytevector-length
+    only (rnrs bytevectors) bytevector-length utf8->string
+    only (srfi srfi-27) random-integer
+    only (ice-9 textual-ports) put-string
+    only (rnrs bytevectors) bytevector->u8-list u8-list->bytevector
+
+
+define : run-ipv4-fibers-server handler-with-path ip
+    fibers:run-server handler-with-path #:family AF_INET #:port 8083 #:addr INADDR_ANY
+    
+define : run-ipv6-fibers-server handler-with-path ip
+    define s
+        let : : s : socket AF_INET6 SOCK_STREAM 0
+            setsockopt s SOL_SOCKET SO_REUSEADDR 1
+            bind s AF_INET6 (inet-pton AF_INET6 ip) 8083
+            . s
+    fibers:run-server handler-with-path #:family AF_INET6 #:port 8083 #:addr (inet-pton AF_INET6 "::") #:socket s
+
+define : run-ipv4-standard-server handler-with-path ip
+    run-server handler-with-path 'http `(#:host "localhost" #:family ,AF_INET #:addr ,INADDR_ANY #:port 8083)
+
+define : run-ipv6-standard-server handler-with-path ip
+    define s
+        let : : s : socket AF_INET6 SOCK_STREAM 0
+            setsockopt s SOL_SOCKET SO_REUSEADDR 1
+            bind s AF_INET6 (inet-pton AF_INET6 ip) 8083
+            . s
+    run-server handler-with-path 'http `(#:family ,AF_INET6 #:addr (inet-pton AF_INET6 "::") #:port 8083 #:socket ,s)
+
 
 define-generic length
 define-method : length (str <string>)

          
@@ 97,17 129,126 @@ define : declare-download-mesh-headers!
     declare-opaque-header! "Content-Range" ;; the content returned
 
 
+define-record-type <range>
+    range start-end data
+    . range?
+    start-end range-start-end ;; cons start end
+    data range-data
+
+define : range-start-> a b
+     . "order the ranges, range with larger start first."
+     > : car : range-start-end a
+         car : range-start-end b
+
+define : merge-ranges received-ranges
+    . "merge ranges in RECEIVED-RANGES into a new list, ordered with the range with the highest start first."
+    let loop : (merged '()) (original (sort received-ranges range-start->))
+        cond 
+            : null? original
+              reverse! merged
+            : null? merged
+              loop : cons (car original) merged
+                     cdr original
+            : equal? (car (range-start-end (first merged))) : + 1 (cdr (range-start-end (first original)))
+              let : (rm (first merged)) (ro (first original))
+                  define dm : range-data rm
+                  define do : range-data ro
+                  define sem : range-start-end rm
+                  define seo : range-start-end ro
+                  define new
+                      range : cons (car seo) (cdr sem)
+                              if : string? dm
+                                   string-append do dm
+                                   u8-list->bytevector
+                                       append (bytevector->u8-list do) (bytevector->u8-list dm)
+                  loop
+                      cons new : cdr merged
+                      cdr original
+            ;; TODO: merge overlapping ranges
+            else
+                loop : cons (car original) merged
+                       cdr original
+
+define : content-range->start-end-size content-range
+    let : : range-string : string-drop (cdr content-range) (string-length "bytes ")
+        define start : string->number : first : string-split range-string #\-
+        define end : string->number : first : string-split (second (string-split range-string #\-)) #\/
+        define size : second : string-split (second (string-split range-string #\-)) #\/
+        values start end
+             if : equal? size "*"
+                . #f
+                string->number size
+
+define : missing-ranges-bytes size received-ranges
+    if : null? received-ranges
+       list : cons 0 size
+       let : :  ranges : map range-start-end : sort received-ranges range-start->
+           define missing-at-end
+               > {size - 1}
+                 cdr : first ranges
+           define missing-initial
+               if : not missing-at-end
+                    list
+                    list 
+                        cons : + 1 : cdr : first ranges
+                             . {size - 1}
+           let loop : (missing missing-initial) (seen '()) (unseen ranges)
+               cond
+                 : null? unseen
+                   . missing
+                 : null? seen
+                   loop missing
+                        cons (car unseen) seen
+                        cdr unseen
+                 else
+                   let : (seen-start (car (first seen))) (unseen-end (cdr (first unseen)))
+                         loop 
+                             if {seen-start > unseen-end}
+                                cons (cons unseen-end seen-start) missing
+                                . missing
+                             cons (car unseen) seen
+                             cdr seen
+
+
 define : download-file url
-    let*
-        : uri : string->uri-reference url
-          headers `((range bytes (0 . #f))) ;; minimal range header so that the server can serve a content range
-        display uri
-        ;; TODO: parse content range response headers, assemble the file from chunks
-        newline
-        let-values : : (resp body) : http-get uri #:headers headers
-          pretty-print resp
-          pretty-print : if (string? body) body : bytevector->string body "ISO-8859-1"
-
+    let loop : (size #f) (received-ranges '())
+        define missing-ranges
+            if : not size
+                 list : cons 0 1
+                 missing-ranges-bytes size received-ranges
+        if : null? missing-ranges
+             range-data (car received-ranges)
+             let*
+                 : uri : string->uri-reference url
+                   range-to-request : list-ref missing-ranges : random-integer : length missing-ranges
+                   headers `((range bytes ,range-to-request)) ;; minimal range header so that the server can serve a content range
+                 display "Downloading file "
+                 display uri
+                 ;; TODO: parse content range response headers, assemble the file from chunks
+                 newline
+                 let-values : : (resp body) : http-get uri #:headers headers
+                    define headers : response-headers resp
+                    define content-range : assoc 'content-range headers
+                    pretty-print size
+                    pretty-print resp
+                    pretty-print headers
+                    pretty-print content-range
+                    pretty-print : if (string? body) body : bytevector->string body "ISO-8859-1"
+                    cond
+                      : not content-range
+                        . body ;; no range-support, so we got the full file by definition
+                      : not : string-prefix? "bytes " : cdr content-range
+                        write : cdr content-range
+                        error "unsupported content-range: content-range header must start with bytes, but it is:"
+                        cdr content-range
+                      else
+                        let-values : : (start end newsize) : content-range->start-end-size content-range
+                            loop : if size size newsize
+                                merge-ranges
+                                    cons : range (cons start end) body
+                                         . received-ranges
+                      
+                  
 
 define : list-files
   let*

          
@@ 128,12 269,12 @@ define : list-files
 
 
 define : get-file-chunk abspath begin end
-    . "open the file, seek to BEGIN, return bytearray from BEGIN to END"
+    . "open the file, seek to BEGIN, return bytearray from BEGIN to END, inclusive"
     if : not : file-exists? abspath
        . ""
        let : : port : open-input-file abspath #:binary #t
          seek port begin SEEK_SET
-         let : : data : if end (get-bytevector-n port (- end begin)) (get-bytevector-all port)
+         let : : data : if end (get-bytevector-n port (+ 1 (- end begin))) (get-bytevector-all port)
            close port
            pretty-print : list abspath begin end data
            if : eof-object? data

          
@@ 173,6 314,7 @@ define : server-serve-file range-request
    define 4KiB : expt 2 12
    define 16B : expt 2 4
    define range-begin : car begin-end
+   ;; TODO: range-end from served size
    define range-end
        if range-requested
           or (cdr begin-end) 16B

          
@@ 191,10 333,11 @@ define : server-serve-file range-request
          base-headers `((content-type . (application/octet-stream))
                         (accept-ranges . (bytes))
                         (X-Alt . ,(xalt->header xalt)))
+         file-size : served-sizebytes : cdr served-file
+         range-end : and range-end : min range-end {file-size - 1}
          headers
              if range-end
-                cons `(content-range . ,(format #f "bytes ~d-~d/~d" range-begin {range-end - 1} 
-                                                            (served-sizebytes (cdr served-file))))
+                cons `(content-range . ,(format #f "bytes ~d-~d/~d" range-begin range-end file-size))
                      . base-headers
                 . base-headers
        values

          
@@ 211,13 354,113 @@ define : server-list-files
           list-files
 
 
-define : server-file-download-handler request body
+define* : string-part-ref s sep key #:optional (matches? string-prefix-ci?)
+    . "Retrieve part identified by KEY in a structured string S with parts separated by SEP. Returns #f if no matching part is found.
+
+The optional MATCHES? is called as (matches? part key)."
+    let loop
+        : parts : string-split-string s sep
+        cond
+          : null? parts
+            . #f
+          : matches? key : car parts
+            car parts
+          else
+            loop : cdr parts
+
+define : part-header-content-disposition part
+    string-part-ref part "\r\n" "content-disposition:"
+
+define : part-header-filename part
+  let*
+      : key "filename=\""
+        disp : part-header-content-disposition part
+        arg : and disp : string-part-ref disp "; " key
+      if arg
+         string-drop
+                string-drop-right arg 1
+                string-length key
+         . #f
+
+define : part-filename part
+    part-header-filename : part-headers part
+
+define : part-headers part
+  let : : sep "\r\n\r\n"
+    car : string-split-string part sep
+
+define : part-content part
+  let : : sep "\r\n\r\n"
+    string-join
+      cdr : string-split-string part sep
+      . sep
+
+define : filename-add-number filename
+    define : random-number-string
+        number->string : random-integer 10
+    let : : extidx : string-index-right filename #\.
+        if : not extidx
+             string-append filename : random-number-string
+             let
+                 : ext : substring filename : + extidx 1
+                   base : substring filename 0 extidx
+                 string-append base : random-number-string
+                   . "." ext             
+
+define : find-free-filename files-path filename
+    let : : files : scandir files-path
+      let loop : : filename filename
+          if : not : member filename files
+             . filename
+             loop : filename-add-number filename
+     
+
+define : save-part-upload files-path part
+    when : part-filename part
+      let*
+        : filename : find-free-filename files-path : basename : part-filename part
+          port : open-output-file (string-append files-path file-name-separator-string filename) #:binary #t
+        put-string port : part-content part
+        close-port port
+
+define : upload files-path request request-body
+  let*
+    : content-type : request-content-type request
+      boundary : string-append "\r\n--" : assoc-ref (cdr content-type) 'boundary ;; following https://www.w3.org/Protocols/rfc1341/7_2_Multipart.html
+      content : bytevector->string request-body : port-encoding : request-port request
+      parts : string-split-string content boundary
+    write : map (λ(x) (save-part-upload files-path x)) parts
+    newline
+    list-files
+
+
+define* : string-split-string s substr #:optional (start 0) (end (string-length s))
+       . "Split string s by substr."
+       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* : substring s start idx
+                                 . pieces
+                     cdr 
+                         reverse 
+                              cons : substring s start
+                                   . pieces
+
+
+
+define : server-file-download-handler folder-path request body
     ;; TODO: serve range requests, see https://developer.mozilla.org/en-US/docs/Web/HTTP/Range_requests
     ;; TODO: return status code 206 for range requests (also for initial?): https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/206
+    define headers : request-headers request
     pretty-print request
     let*
-        : headers : request-headers request
-          range-requested : assoc-item headers 'range
+        : range-requested : assoc-item headers 'range
           begin-end
               if : or (not range-requested) {(length range-requested) < 3}
                  . '(0 . #f)

          
@@ 235,6 478,11 @@ define : server-file-download-handler re
         cond
             : null? path-elements
               server-list-files
+            : equal? '("upload") path-elements
+              when body
+                  upload folder-path request body
+                  update-served-files! folder-path
+              server-list-files
             else
               set! xalt
                   delete-duplicates

          
@@ 255,7 503,7 @@ define : sha256sum path
 define : hash-folder-tree folder-path
     ## 
         tests 
-            test-equal : list : served "test" "files/test" 4 "b5bb9d8014a0f9b1d61e21e796d78dccdf1352f23cd32812f4850b878ae4944c"
+            test-equal : list : served "test" "files/test" 4 "9f86d081884c7d659a2feaa0c55ad015a3bf4f1b2b0b822cd15d6c15b0f00a08"
                 hash-folder-tree "files"
     ;; add a <served> for every file
     define : leaf name stat result

          
@@ 274,7 522,7 @@ define : hash-folder-tree folder-path
     define error ignore
     file-system-fold enter? leaf down up skip error (list) folder-path
 
-define : update-served-files folder-path
+define : update-served-files! folder-path
     define to-serve : hash-folder-tree folder-path
     set! served-files to-serve
     map

          
@@ 285,27 533,15 @@ define : update-served-files folder-path
 
 define : serve folder-path ip
     define : handler-with-path request body
-        server-file-download-handler request body
-    define s
-        let : : s : socket AF_INET6 SOCK_STREAM 0
-            setsockopt s SOL_SOCKET SO_REUSEADDR 1
-            bind s AF_INET6 (inet-pton AF_INET6 ip) 8083
-            . s
-    update-served-files folder-path
+        server-file-download-handler folder-path request body
+    update-served-files! folder-path
     pretty-print served-files
     pretty-print served-hashes
 
     format : current-error-port
            . "Serving ~d files on http://[~a]:~d\n" (length served-files) ip 8083
-    ;; fibers server
-    ;; run-server handler-with-path #:family AF_INET #:port 8083 #:addr INADDR_ANY
-    run-server handler-with-path #:family AF_INET6 #:port 8083 #:addr (inet-pton AF_INET6 "::") #:socket s
-    ;; standard server
-    ;; IPv4
-    ;; run-server handler-with-path 'http `(#:host "localhost" #:family ,AF_INET #:addr ,INADDR_ANY #:port 8083)
-    ;; IPv6
-    ;; run-server handler-with-path 'http `(#:family ,AF_INET6 #:addr (inet-pton AF_INET6 "::") #:port 8083 #:socket ,s)
-
+    run-ipv6-fibers-server handler-with-path ip
+    
 define : help-message args
        ##
          tests

          
@@ 345,5 581,6 @@ define : main args
          let : : ip-opt : or (opt-member arguments "--ip") '("--ip" "::")
              serve (second arguments) (second ip-opt)
        else
-         download-file : car arguments
+         write : download-file : car arguments
+         newline
 

          
M examples/enter-three-witches.scm +63 -21
@@ 1,15 1,15 @@ 
-#!/usr/bin/env sh
-(# -*- wisp -*-)
-(guile -L $(dirname $(dirname $(realpath "$0"))) -c '(import (wisp-scheme) (language wisp spec))')
-(exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples enter-three-witches) main)' -s "$0" "$@")
+#!/usr/bin/env bash
+# -*- wisp -*-
+exec -a "$0" guile -L $(dirname $(dirname $(realpath "$0"))) -e '(examples enter-three-witches)' -c '' "$@"
 ; !#
 
 (define-module (examples enter-three-witches)
-    #:export (introduced-names ->string show colortable color say-words say-name say Speak Speak-indirect Enter Scene))
+    #:export (introduced-names ->string show colortable color say-words say-name say Speak Speak-indirect Enter Scene main))
 
 (use-modules (ice-9 optargs)
               (srfi srfi-1)
-              (system syntax))
+              (system syntax)
+              (ice-9 rdelim))
 
 ;; FIXME: This version currently does not allow using the same first
 ;; name several times. It will need a more refined macro generator

          
@@ 64,35 64,77 @@ 
 
 (define-syntax say-words 
     (lambda (x)
-        (syntax-case x ()
-            ((_ (((word words ...))) (() lines ...))
+        (syntax-case x (fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0)
+            ((_ (((word words ...))) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...))
+              ;; TODO: move out to a helper macro
               #`(begin
-                  (let ((w `word))
-                    (cond
+                 (let ((w `word))
+                   (cond
                      ((equal? w #f)
-                      #f)
+                       #f)
                      ((equal? w '..)
-                      (show "."))
+                       (show "."))
                      (else
-                      (show " ")
-                      (show (->string w)))))
-                  (say-words (((words ...))) (() lines ...))))
-            ((_ ((())) (() lines ...))
+                       (show " ")
+                       (show (->string w)))))
+                 (say-words (((words ...))) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...))))
+            ((_ ((())) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0  (() lines ...))
               #`(begin
                  (usleep 200000)
                  (newline)
                  (say-words (lines ...))))
             ;; lines of form ,(...)
             ((_ ((unq (word words ...)) lines ...))
-              #`(begin if (equal 'unquote `unq))
+              #`(if (equal? 'unquote `unq ));; FIXME: This guard seems to not actually work
               #`(begin ; add an extra level of parens
                  (show " ")
-                 (say-words ((((unq (word words ...))))) (() lines ...))))
-            ((_ ((word words ...) lines ...))
+                 (say-words (((unq (word words ...)))) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...))))
+            ((_ (((unq word)) lines ...))
+              #`(if (equal? 'unquote-splicing `unq ));; FIXME: This guard seems to not actually work
+              #`(begin ; include the unquoting without extra level of parentheses
+                 ;; TODO: clean this up. This duplicates logic in the first case, and duplicates it again internally.
+                 (show " ")
+                 (apply
+                     (λ (unq x)
+                        (cond
+                          ((equal? 'unquote-splicing unq)
+                            (map (λ (x) (show " ")(show x))
+                                (if (pair? x)
+                                     (map ->string x)
+                                     x)))
+                          ((equal? 'unquote unq)
+                            (cond
+                              ((equal? x #f)
+                                #f)
+                              ((equal? x '..)
+                                (show "."))
+                              (else
+                                (show " ")
+                                (show (->string x)))))
+                          (else
+                            (cond
+                              ((equal? unq #f)
+                                #f)
+                              ((equal? unq '..)
+                                (show "."))
+                              (else
+                                (show " ")
+                                (show (->string unq))))
+                            (cond
+                              ((equal? x #f)
+                                #f)
+                              ((equal? x '..)
+                                (show "."))
+                              (else
+                                (show " ")
+                                (show (->string x)))))))
+                     (list 'unq word))
+                 (say-words ((())) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...))))
+            ((_ ((word words ...) lines ...) ); start of a line
               #`(begin
                  (show " ")
-                 (say-words (((word words ...))) (() lines ...))))
-            ((_ (() lines ...))
+                 (say-words (((word words ...))) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...))))
+            ((_ (() lines ...) ); finished showing the line, show the next one
               #`(say-words (lines ...)))
             ((_ (lines ...))
               #`(begin

          
A => examples/evaluate-r7rs-benchmark.gnuplot +10 -0
@@ 0,0 1,10 @@ 
+# create data with r7rs-benchmark: cp ~/eigenes/Programme/r7rs-benchmarks/all.csv r7rs-benchmark-all.csv; for i in 1.8.8 2.0.14 2.2 2.9; do ./evaluate-r7rs-benchmark.w r7rs-benchmark-all.csv guile-$i --csv > /tmp/r7rs-bench-slowdown-guile-$i.csv; done; gnuplot -c evaluate-r7rs-benchmark.gnuplot
+set title "Slowdown vs. fastest, progression in Guile, using https://ecraven.github.io/r7rs-benchmarks/"
+set xtics rotate 45
+set log y
+set yrange [0.9:50]
+set ylabel "Slowdown vs. fastest / dimensionless"
+set xlabel "specific test"
+set terminal png size 1024,768 linewidth 2
+set output "evaluate-r7rs-benchmark.png"
+plot "/tmp/r7rs-bench-slowdown-guile-1.8.8.csv" u 0:($2):xtic(1) w linespoints title "1.8", "/tmp/r7rs-bench-slowdown-guile-2.0.14.csv" u 0:($2):xtic(1) w linespoints title "2.0", "/tmp/r7rs-bench-slowdown-guile-2.2.csv" u 0:($2):xtic(1) w linespoints title "2.2", "/tmp/r7rs-bench-slowdown-guile-2.9.csv" u 0:($2):xtic(1) w linespoints  title "2.9"

          
M examples/evaluate-r7rs-benchmark.w +38 -2
@@ 70,8 70,29 @@ define : get-multiples guile-data data-m
                      . multiples-of-best
 
 
+define : get-multiples-alist guile-data data-min-by-test
+  let lp 
+      : gd guile-data
+        multiples-of-best '()
+      if : null? gd
+         remove (λ(x) (equal? #f x)) multiples-of-best
+         let*
+             : guile : string->number : car : cdr : car gd
+               test : car : car gd
+               multiple
+                 if : not guile
+                    cons test guile
+                    cons test 
+                      / guile
+                        or (assoc-ref data-min-by-test test) guile
+             lp : cdr gd
+                  if multiple
+                     cons multiple multiples-of-best
+                     . multiples-of-best
+
+
 define : help args
-    format #t "Usage: ~a csv-file [project-prefix]\n" (car args)
+    format #t "Usage: ~a [--help] [--csv] csv-file [project-prefix]\n" (car args)
 
 define args : program-arguments
 

          
@@ 88,11 109,26 @@ define project-prefix
        car : cdr : cdr args
 
 define : main args
+    when : and {(length args) > 1} : equal? "--help" : second args 
+         help args
+         exit 0
     let*
       : port : open-input-file csv-file
         data-by-project : read-csv port
         data-min-by-test : min-alist-by-test data-by-project
         guile-data : select-project-data data-by-project project-prefix
+      when : member "--csv" args
+          ; display "test slowdown\n"
+          map : λ (x) : apply format #t "~a ~a\n" : list (car x) (cdr x)            
+                  get-multiples-alist guile-data data-min-by-test          
+          format #t "total ~a\n"
+              if : null? : get-multiples guile-data data-min-by-test
+                  . #f
+                  expt
+                      apply * : get-multiples guile-data data-min-by-test
+                      / 1 : length : get-multiples guile-data data-min-by-test
+          exit 0
+          
       display "=== Best times ===\n\n"
       pretty-print : sort data-min-by-test (λ (x y) (string<? (car x) (car y)))
       newline

          
@@ 100,7 136,7 @@ define : main args
       pretty-print : sort guile-data (λ (x y) (string<? (car x) (car y)))
       newline
       format #t "=== ~a slowdown ===\n\n" : string-locale-titlecase project-prefix
-      pretty-print : get-multiples guile-data data-min-by-test
+      pretty-print : get-multiples-alist guile-data data-min-by-test
       newline
       format #t "=== ~a Geometric Mean slowdown (successful tests / total tests) ===\n\n" : string-locale-titlecase project-prefix
       format #t "~a (~a / ~a)"

          
A => examples/files/test +1 -0
@@ 0,0 1,1 @@ 
+test
  No newline at end of file

          
A => examples/graph-algorithms.w +116 -0
@@ 0,0 1,116 @@ 
+#!/usr/bin/env bash
+# -*- wisp -*- 
+# set Guile if unset
+if [ -z ${GUILE+x} ]; then
+	GUILE=guile
+fi
+exec -a "$0" "${GUILE}" -L "$(dirname "$(dirname "$(realpath "$0")")")" -x .w --language=wisp -e '(examples graph-algorithms)' -c '' "$@"
+; !#
+
+define-module : examples graph-algorithms
+   . #:export : main
+
+import : ice-9 pretty-print
+         srfi srfi-4
+
+define nodelist : list->u16vector : iota : * 64 1024 ;; max value for u16 vector!
+
+define : create-edges
+  define nodecount : u16vector-length nodelist
+  define edgecount {nodecount * 100}
+  define edgecar : make-u16vector edgecount
+  define edgecdr : make-u16vector edgecount
+  let loop : (edgeidx  0) (nodeidx 0)
+      when {nodeidx < nodecount}
+          let lp : : edges-of-this-node 0
+              cond
+                {edges-of-this-node < 100}
+                  u16vector-set! edgecar {edgeidx + edges-of-this-node} nodeidx
+                  u16vector-set! edgecdr {edgeidx + edges-of-this-node} 
+                      modulo {nodeidx + edges-of-this-node} nodecount
+                  lp {edges-of-this-node + 1}
+                else
+                  loop {edgeidx + edges-of-this-node} {nodeidx + 1}
+                  
+  cons edgecar edgecdr
+
+define : nodes-and-edges->adjacency-lists-by-index nodelist edges
+    . "Assemble adjacency lists by index in the nodelist"
+    define number-of-nodes : u16vector-length nodelist
+    define number-of-edges : u16vector-length : car edges
+    define adjacency-lists : make-vector number-of-nodes 0
+    define adjacency-lists-current-idx : make-u16vector number-of-nodes 0
+    define edge-start : car edges
+    define edge-target : cdr edges
+    define : get-start idx
+        u16vector-ref edge-start idx
+    define : get-end idx
+        u16vector-ref edge-target idx
+    ;; count targets per node
+    let loop : : idx {number-of-edges - 1}
+        when {idx > 0}
+           let : : start : get-start idx
+               vector-set! adjacency-lists start
+                  + 1 : vector-ref adjacency-lists start
+           loop {idx - 1}
+    ;; prepare u16vectors
+    let loop : : idx {number-of-nodes - 1}
+        when {idx > -1}
+           let : : len : vector-ref adjacency-lists idx
+             if {len = 0}
+                 vector-set! adjacency-lists idx #f
+                 vector-set! adjacency-lists idx : make-u16vector {len + 1}
+           loop {idx - 1}
+    ;; collect edges
+    let loop : : idx {number-of-edges - 1}
+        when {idx > -1}
+           let* 
+               : start : get-start idx
+                 edgelist-idx : u16vector-ref adjacency-lists-current-idx start
+               u16vector-set! : vector-ref adjacency-lists start
+                   . edgelist-idx
+                   get-end idx
+               u16vector-set! adjacency-lists-current-idx start {edgelist-idx + 1}
+           loop {idx - 1}
+    . adjacency-lists
+
+
+define : bfs adjacency-list seed
+    . "Traverse all nodes in the adjacency list via breadth first search"
+    define discovered : make-bitvector (vector-length adjacency-list) #f
+    define processed : make-bitvector (vector-length adjacency-list) #f
+    bitvector-set! discovered seed #t
+    let loop : : queue : list seed
+        if : null? queue
+           . #f ;; done
+           let*
+               : current-node : car queue
+                 edges : vector-ref adjacency-list current-node
+                 edgecount : if edges (u16vector-length edges) 0
+               ;; display current-node
+               ;; newline
+               let lp
+                   : idx {edgecount - 1}
+                     new : list
+                   if {idx < 0}
+                     loop : append (cdr queue) new
+                     let : : current-target : u16vector-ref edges idx
+                         cond
+                           : not : bitvector-ref discovered current-target
+                             bitvector-set! discovered current-target #t
+                             lp {idx - 1} : cons current-target new
+                           else
+                             lp {idx - 1} new
+                       
+
+define : main args
+    define edgelist : create-edges
+    define adjacency : nodes-and-edges->adjacency-lists-by-index nodelist edgelist
+    pretty-print 'adjacency-created
+    pretty-print : vector-ref adjacency 0
+    ; pretty-print : nodes-and-edges->adjacency-lists-by-index nodelist edges
+    bfs adjacency 0
+    ;; let lp : : i 1000000000
+    ;;     when {i > 0}
+    ;;         lp {i - 1}
+    

          
A => examples/guile-gi.w +62 -0
@@ 0,0 1,62 @@ 
+#!/usr/bin/env bash
+# -*- wisp -*-
+# REQUIREMENTS:
+# - Guile-GI
+# - libffi
+# - GLib
+# - GObject-Introspection aka GIRepository
+# set Guile if unset
+if [ -z ${GUILE+x} ]; then
+	GUILE=guile
+fi
+# temporary workaround to find libguile-gi
+export GUILE_SYSTEM_EXTENSIONS_PATH="$HOME/.guix-profile/lib/guile/3.0/"
+"${GUILE}" -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp spec))'
+exec -a "$0" "${GUILE}" -L $(dirname $(dirname $(realpath "$0"))) -x .w --language=wisp -e '(examples guile-gi)' -c '' "$@"
+; !#
+
+define-module : examples guile-gi
+   . #:export : main
+
+import (gi) (gi repository)
+
+require "Gio" "2.0"
+require "Gtk" "3.0"
+
+load-by-name "Gio" "Application" ;; activate, run
+load-by-name "Gtk" "Application"
+load-by-name "Gtk" "ApplicationWindow"
+load-by-name "Gtk" "Button"
+load-by-name "Gtk" "ButtonBox"
+load-by-name "Gtk" "Widget" ;; show-all
+load-by-name "Gtk" "DrawingArea"
+
+define : print-hello widget
+  display "Hello World\n"
+
+define : activate-callback app
+  let*
+      : window (make <GtkApplicationWindow>
+                #:application app
+                #:default-height 200
+                #:default-width 200
+                #:title "Window")
+        button-box (make <GtkButtonBox> #:parent window)
+        button (make <GtkButton>
+                #:parent button-box
+                #:label "Hello world")
+        ;; DrawingArea does not work yet: https://developer.gnome.org/gtk3/stable/GtkDrawingArea.html
+        drawing-area (make <GtkDrawingArea>
+                      #:parent window)
+    widget:set-size-request drawing-area 100 100
+    connect drawing-area draw : lambda _ (write 1) (newline)
+    connect button clicked print-hello
+    connect button clicked : lambda _ : destroy window
+    show-all window
+
+define : main
+  let : : app (make <GtkApplication> #:application-id "org.gtk.example")
+    connect app activate activate-callback
+    run app : command-line
+
+main

          
M examples/hamming.w +1 -2
@@ 36,8 36,7 @@ define : hamming-11/7-encode numbers
                test-equal '(0 0 1 0 0 0 0 1 0 0 1)
                    hamming-11/7-encode '(1 0 0 0 0 0 1)
 
-       define : H . bits
-           apply mod2sum bits
+       define H mod2sum
        match numbers
            : i3 i5 i6 i7 i9 i10 i11
              list

          
A => examples/heapsort.w +69 -0
@@ 0,0 1,69 @@ 
+#!/usr/bin/env bash
+# -*- wisp -*-
+# Just a fun example of a heapsort using a vector
+# set Guile if unset
+if [ -z ${GUILE+x} ]; then
+	GUILE=guile
+fi
+echo ${GUILE}
+"${GUILE}" -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp spec))'
+exec -a "$0" "${GUILE}" -L $(dirname $(dirname $(realpath "$0"))) -x .w --language=wisp -e '(examples heapsort)' -c '' "$@"
+; !#
+
+define-module : examples heapsort
+   . #:export : main
+
+import : only (srfi srfi-43) vector-swap!
+         ice-9 pretty-print
+
+define : heapsort data
+    define array : list->vector data
+    define len : vector-length array
+    ;; heaps use 1-indexed indizes for their simple next-index
+    ;; calculation, so we use our own functions
+    define : heap-set! i value
+        vector-set! array { i - 1 } value
+    define : heap-ref i
+        vector-ref array { i - 1 }
+    define : heap-swap! i j
+        vector-swap! array { i - 1 } { j - 1 }
+    
+    define : left-child n
+        * 2 n
+    define : right-child n
+        + 1 : left-child n
+    define : parent n
+        if {n = 1} 
+           . -1
+           floor/ n 2
+    define : bubble-down! p
+        define min-index p
+        define : update-min-index! child-index
+            when { child-index < { len + 1 } }
+                when : < (heap-ref child-index) (heap-ref min-index)
+                    set! min-index child-index
+        update-min-index! : left-child p
+        update-min-index! : right-child p
+        when : not { min-index = p }
+            heap-swap! p min-index
+            bubble-down! min-index
+    define : extract-min!
+        define min -1
+        when { len > 0 }
+            set! min : heap-ref 1
+            heap-set! 1 : heap-ref { len }
+            heap-set! len #f
+            set! len { len - 1 }
+            bubble-down! 1
+        . min
+    let loop : : i : floor/ len 2
+        when {i >= 1}
+            bubble-down! i
+            loop { i - 1 }
+    map : λ _ : extract-min!
+        . data
+
+define : main args
+    define data : reverse! : iota 100000
+    display : car : heapsort data
+    newline

          
A => examples/ptifrrabirrf.w +19 -0
@@ 0,0 1,19 @@ 
+;; the name is an in-joke
+import
+    only (fake import) file-or-http-url?
+                     . resource-reference string-replace-substring
+
+define : ptifrrabirrf path unresolved
+    define : convert s
+             string-replace-substring s "%20" " "
+    when : or (not path) (not unresolved)
+           error "Illegal Argument: path and unresolved must not be #false,
+but path was ~a and unresolved was ~a"
+                 . path unresolved
+
+    if : or (file-or-http-url? path) (file-exists? path)
+       resource-reference path unresolved
+       let : : converted-path : convert path
+           if : file-exists? converted-path
+                resource-reference converted-path : convert unresolved
+                resource-reference path unresolved

          
M examples/securepassword.w +13 -2
@@ 1,7 1,15 @@ 
 #!/usr/bin/env bash
 # -*- wisp -*-
-guile -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp) (language wisp spec))'
-exec -a "$0" guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -x .w -e '(examples securepassword)' -c '' "$@"
+if ! guile --language=wisp -c '' 2>/dev/null; then
+    guile -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp) (language wisp spec))' >/dev/null 2>&1
+fi
+PROG="$0"
+if [[ "$1" == "-i" ]]; then
+    shift
+    exec -a "${PROG}" guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -x .w -e '(examples securepassword)' -- "${@}"
+else
+    exec -a "${PROG}" guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -x .w -e '(examples securepassword)' -c '' "${@}" 2>/dev/null
+fi;
 ; !#
 
 ;; Create secure passwords, usable on US and German keyboards without problems

          
@@ 124,6 132,9 @@ exec -a "$0" guile -L $(dirname $(dirnam
 ;;   with 2-gramme.arne.txt from https://bitbucket.org/ArneBab/evolve-keyboard-layout
 ;;   ./securepassword.w 
 
+;; To simplified diceware: for i in 0 1 2 3 4 5 6 7 8 9 A B C D E F G H J K L M N P Q R T U V W X a b c d e f g h i j k m n o p q r s t u v w x ; do grep "\ [^ -.].$"  securepassword.corpus | grep "$i\$"  | head -n 1; done | sort -g
+;; 16 27 38 49 50 A B CHR D E FPQ GKJ LVU MN TWX a b c d e f g h i jq k m n o p r s t v w x
+
 define-module : examples securepassword
               . #:export : password yearstillcrackable letterblocks letterblocks-nice main
 

          
A => examples/threaded-writing.w +36 -0
@@ 0,0 1,36 @@ 
+#!/usr/bin/env bash
+# -*- wisp -*-
+# set Guile if unset
+if [ -z ${GUILE+x} ]; then
+	GUILE=guile
+fi
+echo ${GUILE}
+"${GUILE}" -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp spec))'
+exec -a "$0" "${GUILE}" -L $(dirname $(dirname $(realpath "$0"))) -x .w --language=wisp -e '(examples threaded-writing)' -c '' "$@"
+; !#
+
+define-module : examples threaded-writing
+   . #:export : main
+
+import : ice-9 threads
+
+define : help args
+    format #t "~a [--help] [--test]\n" (car args)
+
+define : write-threaded args
+            define status-output-mutex : make-mutex
+
+            define : status-message msg i
+              lock-mutex status-output-mutex
+              format #t "~d ~a\n" i msg
+              unlock-mutex status-output-mutex
+
+            par-map status-message args : iota : length args
+
+
+define : main args
+    cond
+        : and {(length args) > 1} : equal? "--help" : car : cdr args
+          help args
+        else
+          write-threaded args

          
A => examples/triangle.w +36 -0
@@ 0,0 1,36 @@ 
+#!/usr/bin/env bash
+# -*- wisp -*-
+# set Guile if unset
+if [ -z ${GUILE+x} ]; then
+	GUILE=guile
+fi
+"${GUILE}" -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp spec))' 2>/dev/null 1>/dev/null
+exec -a "$0" "${GUILE}" -L $(dirname $(dirname $(realpath "$0"))) -x .w --language=wisp -e '(examples triangle)' -c '' "$@" 2>/dev/null
+; !#
+
+;;; Just converted for fun from the OCaml solution by Andrew Kensler
+;;; at
+;;; http://www.frank-buss.de/challenge/solutions/andrew-func.ml.html
+;;; for the triangle counting challenge
+;;; http://www.frank-buss.de/challenge/index.html
+
+define-module : examples triangle
+   . #:export : main
+
+define : count_func lsides rsides
+  define rsides-1 {rsides - 1}
+  define lsides-1 {lsides - 1}
+  let loop : (ls 0) (rs 0) (le 0) (re 0) (total 0)
+    define new_tot 
+        if : or {ls = 0} {rs = 0}
+           . {total + 1} total
+    cond
+        {re < rsides-1} : loop ls rs le { re + 1 } new_tot
+        {le < lsides-1} : loop ls rs { le + 1 } rs new_tot
+        {rs < rsides-1} : loop ls { rs + 1 } ls { rs + 1 } new_tot
+        {ls < lsides-1} : loop { ls + 1 } 0 { ls + 1 } 0 new_tot
+        else new_tot
+
+define : main args
+    display : count_func 3 3
+    newline

          
M examples/upload-server.w +1 -4
@@ 61,9 61,6 @@ The optional MATCHES? is called as (matc
 define : part-header-content-disposition part
     string-part-ref part "\r\n" "content-disposition:"
 
-define : part-content-disposition part
-    post-part-header-content-disposition : part-headers part
-
 define : part-header-filename part
   let*
       : key "filename=\""

          
@@ 119,7 116,7 @@ define : save-part-upload part
 define : upload request request-body
   let*
     : content-type : request-content-type request
-      boundary : assoc-ref (cdr content-type) 'boundary
+      boundary : string-append "\r\n--" : assoc-ref (cdr content-type) 'boundary ;; following https://www.w3.org/Protocols/rfc1341/7_2_Multipart.html
       content : bytevector->string request-body : port-encoding : request-port request
       parts : string-split-string content boundary
     write : map save-part-upload parts

          
M ob-wisp.el +12 -4
@@ 8,6 8,9 @@ 
 ;; Keywords: literate programming, reproducible research
 ;; Homepage: http://orgmode.org
 
+;; Version: 0.1
+;; Keywords: languages, lisp
+
 ;; This file is not part of GNU Emacs. It is modified from ob-python.el
 
 ;; GNU Emacs is free software: you can redistribute it and/or modify

          
@@ 27,6 30,10 @@ 
 
 ;; Org-Babel support for evaluating wisp source code.
 
+;; ChangeLog:
+;;  - 0.1: search for modules with .w extension
+
+
 ;;; Code:
 (require 'ob)
 (eval-when-compile (require 'cl))

          
@@ 41,7 48,8 @@ 
 
 (defvar org-babel-default-header-args:wisp '())
 
-(defcustom org-babel-wisp-command "guile -L $HOME/wisp --language=wisp -e '(lambda (args) (set! (@@ (system repl common) repl-welcome) (const #f)))'"
+(defcustom org-babel-wisp-command "guile -L $HOME/wisp --language=wisp -x .w -e '(lambda (args) (set! (@@ (system repl common) repl-welcome) (const #f)))' -c ''"
+  ;; setting repl-welcome to #f gets rid of printing the REPL prefix and Guile version
   "Name of the command for executing Wisp code."
   :version "24.4"
   :package-version '(Org . "8.0")

          
@@ 271,13 279,13 @@ last statement in BODY, as elisp."
                         (lambda (line) (format "\t%s" line))
                         (split-string
                          (org-remove-indentation
-                          (org-babel-trim body))
+                          (org-trim body))
                          "[\r\n]") "\n")
                        (org-babel-process-file-name tmp-file 'noquote))))
                     (org-babel-eval-read-file tmp-file))))))
     (org-babel-result-cond result-params
       raw
-      (org-babel-wisp-table-or-string (org-babel-trim raw)))))
+      (org-babel-wisp-table-or-string (org-trim raw)))))
 
 (defun org-babel-wisp-evaluate-session
     (session body &optional result-type result-params)

          
@@ 334,7 342,7 @@ last statement in BODY, as elisp."
         (org-babel-wisp-table-or-string results)))))
 
 (defun org-babel-wisp-read-string (string)
-  "Strip \"s from around Wisp string."
+  "Strip \"s from around Wisp STRING."
   (if (string-match "^\"\\([^\000]+\\)\"$" string)
       (match-string 1 string)
     string))

          
M wisp-mode.el +80 -61
@@ 5,7 5,7 @@ 
 ;;               from https://github.com/kwrooijen/indy/blob/master/indy.el
 
 ;; Author: Arne Babenhauserheide <arne_bab@web.de>
-;; Version: 0.2.3
+;; Version: 0.2.6
 ;; Keywords: languages, lisp
 
 ;; This program is free software; you can redistribute it and/or

          
@@ 23,13 23,13 @@ 
 
 ;;; Commentary:
 
-;; To use, add wisp-mode.el to your emacs lisp path and add the following
+;; To use, add wisp-mode.el to your Emacs Lisp path and add the following
 ;; to your ~/.emacs or ~/.emacs.d/init.el
 ;; 
 ;; (require 'wisp-mode)
 ;; 
-;; For details on wisp, see 
-;; http://draketo.de/light/english/wisp-lisp-indentation-preprocessor
+;; For details on wisp, see
+;; https://www.draketo.de/english/wisp
 ;;
 ;; If you came here looking for wisp the lisp-to-javascript
 ;; compiler[1], have a look at wispjs-mode[2].

          
@@ 39,9 39,15 @@ 
 ;; [2]: http://github.com/krisajenkins/wispjs-mode
 ;; 
 ;; ChangeLog:
-;; 
+;;
+;;  - 0.2.6: remove unnecessary autoloads
+;;  - 0.2.5: backtab chooses existing lower indentation values from previous lines.
+;;  - 0.2.4: better indentation support:
+;;           cycle forward on tab,
+;;           cycle backwards on backtab (s-tab),
+;;           keep indentation on enter.
 ;;  - 0.2.1: Disable electric-indent-local-mode in wisp-mode buffers.
-;;  - 0.2: Fixed the regular expressions. Now org-mode HTML export works with wisp-code.
+;;  - 0.2: Fixed the regular expressions.  Now org-mode HTML export works with wisp-code.
 ;; 
 ;;; Code:
 

          
@@ 85,9 91,9 @@ 
      ; ("^_+ *$" . font-lock-default-face) ; line with only underscores
                                            ; and whitespace shown as
                                            ; default text. This is just
-                                           ; a bad workaround. 
-                                           ; Which does not work because 
-                                           ; *-default-face is not guaranteed 
+                                           ; a bad workaround.
+                                           ; Which does not work because
+                                           ; *-default-face is not guaranteed
                                            ; to be defined.
      ("^\\(?:_* +\\| *\\): *$" . font-lock-keyword-face) ; line with only a : + whitespace, not at the beginning
      ("^\\(?:_* +\\| *\\): \\| *\\. " . font-lock-keyword-face) ; leading : or .

          
@@ 111,11 117,22 @@ 
      ))
   "Default highlighting expressions for wisp mode.")
 (defun wisp--prev-indent ()
-  "Get the amount of indentation spaces if the previous line."
+  "Get the amount of indentation spaces of the previous line."
   (save-excursion
-    (previous-line 1)
+    (forward-line -1)
     (while (wisp--line-empty?)
-      (previous-line 1))
+      (forward-line -1))
+    (back-to-indentation)
+    (current-column)))
+
+(defun wisp-prev-indent-lower-than (indent)
+  "Get the indentation which is lower than INDENT among previous lines."
+  (save-excursion
+    (forward-line -1)
+    (while (or (wisp--line-empty?)
+               (and (>= (wisp--current-indent) indent)
+                    (> (wisp--current-indent) 0)))
+      (forward-line -1))
     (back-to-indentation)
     (current-column)))
 

          
@@ 142,61 159,60 @@ 
 
 (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)))))
+  (let ((currcol (current-column))
+        (currind (wisp--current-indent)))
+    (unless (equal currind num)
+      (let ((num (max num 0)))
+        (indent-line-to num))
+      (unless (<= currcol currind)
+        (move-to-column (indy--fix-num (+ num (- currcol currind))))))))
 
-;;;###autoload
 (defun wisp--tab ()
-  "Cycle through indentations depending on the previous line."
+  "Cycle through indentations depending on the previous line.
+
+If the current indentation is equal to the previous line,
+   increase indentation by one tab,
+if the current indentation is zero,
+   indent up to the previous line
+if the current indentation is less than the previous line,
+   increase by one tab, but at most to 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))))
+         (width
+          (cond
+           ((equal curr prev) (+ prev tab-width))
+           ((= curr 0) prev)
+           ((< curr prev) (min prev (+ curr tab-width)))
+           (t  0))))
     (wisp--indent width)))
 
+(defun wisp--backtab ()
+  "Cycle through indentations depending on the previous line.
+
+This is the inverse of 'wisp--tab', except that it jums from 0 to
+prev, not to prev+tab."
+  (interactive)
+  (let* ((curr (wisp--current-indent))
+         (prev (wisp--prev-indent))
+         (width
+          (cond
+           ((<= curr prev)
+            (wisp-prev-indent-lower-than curr))
+           ((= curr 0) prev)
+           ((> curr prev) prev)
+           (t  0))))
+    (wisp--indent width)))
+
+(defun wisp--return ()
+  "Enter a newline while keeping indentation."
+  (interactive)
+  (let* ((curr (wisp--current-indent))
+         (prev (wisp--prev-indent)))
+    (newline)
+    (wisp--indent curr)))
+
 
-(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

          
@@ 205,7 221,7 @@ indent-relative."
   "Major mode for whitespace-to-lisp files.
 
   \\{wisp-mode-map}"
-  ; :group wisp
+  ;; :group wisp
   (set (make-local-variable 'indent-tabs-mode) nil)
   (setq comment-start ";")
   (setq comment-end "")

          
@@ 213,7 229,10 @@ indent-relative."
   (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>") 'wisp--tab))
+  ;; bind keys to \r, not (kbd "<return>") to allow completion to work on RET
+  (define-key wisp-mode-map (kbd "<tab>") '("indent line" . wisp--tab))
+  (define-key wisp-mode-map (kbd "<backtab>") '("unindent line" . wisp--backtab))
+  (define-key wisp-mode-map "\r" '("wisp newline" . wisp--return)))
 
                         
 

          
M wisp-reader.w +5 -4
@@ 18,14 18,15 @@ define-module : language wisp spec
 ; Set locale to something which supports unicode. Required to avoid using fluids.
 catch #t
       lambda :
-        setlocale LC_ALL ""
+        setlocale LC_ALL "foo"
       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         "
+                  list ";;; Warning: setlocale LC_ALL \"\" failed with ~A: ~A"
+                     . "switching to explicit ~A locale. Please setup your locale."
+                     . "If this fails, you might need glibc support for unicode locales.\n"
+                  .  "\n;;;          "
               . key parameters locale-fallback
           setlocale LC_ALL locale-fallback
 

          
M wisp-scheme.w +1 -1
@@ 8,7 8,7 @@ exec guile -L . --language=wisp -s "$0" 
 ;; preprocessed file.
 
 ;; Limitations:
-;; - only unescapes up to 6 leading underscores at line start (\______)
+;; - only unescapes up to 12 leading underscores at line start (\____________)
 ;; - in some cases the source line information is missing in backtraces.
 ;;   check for set-source-property!
 

          
A => wisp.in +7 -0
@@ 0,0 1,7 @@ 
+#!/usr/bin/env bash
+# -*- wisp -*-
+# set Guile if unset
+if [ -z ${GUILE+x} ]; then
+	GUILE=guile
+fi
+exec -a "$0" "${GUILE}" -x .w --language=wisp "$@"