(Arne Babenhauserheide)
2017-10-17: install language/wisp.scm + debugging stable v0.9.7 install language/wisp.scm + debugging
diff --git a/.bugs/bugs b/.bugs/bugs
--- a/.bugs/bugs
+++ b/.bugs/bugs
@@ -14,6 +14,7 @@ multiple escaped initial underscores mus
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
+bootstrapping does not pre-compile correctly anymore | owner:Arne Babenhauserheide <bab@draketo.de>, open:True, id:499afb16915b64d56aff710d292b46ddaa060869, time:1507501352.6
wisp-in-wisp: only parses the first 272 lines, for some reason. | owner:, open:False, id:4cb6c556d7136609e2da9ab3fc045a39847f1ef3, time:1377014682.98
adjust runtests.sh to use testrunner.w | owner:, open:False, id:4d4e76343fe09f0ec72a3e5eb0077bd16e12f9d5, time:1415127234.43
wisp-scheme: REPL: sometimes the output of a command is only shown after typing the next non-empty line. | owner:, open:False, id:56d2f81e9c89accb0b0bc668ddc8feed3b60e9b2, time:1416584789.23
diff --git a/.bugs/details/499afb16915b64d56aff710d292b46ddaa060869.txt b/.bugs/details/499afb16915b64d56aff710d292b46ddaa060869.txt
new file mode 100644
--- /dev/null
+++ b/.bugs/details/499afb16915b64d56aff710d292b46ddaa060869.txt
@@ -0,0 +1,31 @@
+# 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
+
+
+[expected]
+# The expected result
+
+
+[actual]
+# What happened instead
+
+
+[reproduce]
+# Reproduction steps
+wget https://bitbucket.org/ArneBab/wisp/downloads/wisp-0.9.6.tar.gz;
+tar xf wisp-0.9.6.tar.gz ; cd wisp-0.9.6/;
+./configure; make check;
+examples/newbase60.w 123
+
+^ shows compilation errors which go away after a short guile ... -c '(import (language wisp spec))'
+
+[comments]
+# Comments and updates - leave your name
diff --git a/Makefile.am b/Makefile.am
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,7 +1,7 @@
SUFFIXES = .w .scm .sh
sitedir = $(GUILE_SITE)
-site_DATA = wisp-scheme.scm
+site_DATA = language/wisp.scm
langdir = ${datarootdir}/guile/site/$(GUILE_EFFECTIVE_VERSION)/language/wisp
lang_DATA = language/wisp/spec.scm language/wisp.scm
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,8 @@
wisp ():
+wisp 0.9.7:
+- FIX: install language/wisp.scm instead of wisp-scheme.scm
+
wisp 0.9.6:
- Add a warning with undefined indentation levels: they can
produce surprising behaviour when changing existing code.
diff --git a/configure.ac b/configure.ac
--- a/configure.ac
+++ b/configure.ac
@@ -1,7 +1,7 @@
dnl run `autoreconf -i` to generate a configure script.
dnl Then run ./configure to generate a Makefile.
dnl Finally run make to generate the project.
-AC_INIT([wisp], [0.9.6],
+AC_INIT([wisp], [0.9.7],
[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])
diff --git a/examples/benchmark.w b/examples/benchmark.w
--- a/examples/benchmark.w
+++ b/examples/benchmark.w
@@ -76,10 +76,10 @@ define* : benchmark-run fun
: res : list-ec (: i sampling-steps) : benchmark-run-single fun #:min-seconds min-seconds
std : stddev-unbiased-normal res
mean : / (apply + res) sampling-steps
- ;; pretty-print : list mean '± std min-seconds sampling-steps
- if : or {sampling-steps > max-iterations} : and {std < {mean * max-relative-uncertainty}} {std < max-absolute-uncertainty-seconds}
- . mean
- lp (* 2 min-seconds) (* 2 sampling-steps) ;; should decrease σ by factor 2 or √2 (for slow functions)
+ ;; pretty-print : list mean '± std min-seconds sampling-steps
+ if : or {sampling-steps > max-iterations} : and {std < {mean * max-relative-uncertainty}} {std < max-absolute-uncertainty-seconds}
+ . mean
+ lp (* 2 min-seconds) (* 2 sampling-steps) ;; should decrease σ by factor 2 or √2 (for slow functions)
define loopcost
benchmark-run (λ() #f)
diff --git a/examples/doctests-test.scm b/examples/doctests-test.scm
--- a/examples/doctests-test.scm
+++ b/examples/doctests-test.scm
@@ -1,4 +1,5 @@
#!/usr/bin/env sh
+# -*- scheme -*-
exec guile -L $(dirname $(dirname $(realpath "$0"))) -e '(@@ (examples doctests-test) main)' -s "$0" "$@"
; !#
@@ -7,18 +8,17 @@ exec guile -L $(dirname $(dirname $(real
(import (examples doctests))
(define (foo)
- "(test 'foo
- (test-equal \"bar\" (foo)))
- "
+ #((tests
+ ('foo
+ (test-equal "bar" (foo)))))
"bar")
(define %this-module (current-module))
(define (main args)
- " Testing doctests
- (test 'mytest
- (test-assert #t)
- (test-assert #f))
-"
+ " Testing doctests"
+ #((tests ('mytest
+ (test-assert #t)
+ (test-assert #f))))
(doctests-testmod %this-module))
diff --git a/examples/doctests-test.w b/examples/doctests-test.w
--- a/examples/doctests-test.w
+++ b/examples/doctests-test.w
@@ -1,7 +1,7 @@
#!/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 doctests-test) main)' -s "$0" "$@"
+guile -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp spec))'
+exec guile -L $(dirname $(dirname $(realpath "$0"))) -x .w --language=wisp -e '(@@ (examples doctests-test) main)' -s "$0" "$@"
; !#
define-module : examples doctests-test
@@ -9,17 +9,16 @@ define-module : examples doctests-test
import : examples doctests
define : foo
- . "(test 'foo
- (test-equal \"bar\" (foo)))
- "
+ . #((tests
+ ('foo
+ (test-equal "bar" (foo)))))
. "bar"
define %this-module : current-module
define : main args
- . " Testing doctests
- (test 'mytest
- (test-assert #t)
- (test-assert #f))
-"
+ . " Testing doctests"
+ . #((tests ('mytest
+ (test-assert #t)
+ (test-assert #f))))
doctests-testmod %this-module
diff --git a/examples/doctests-testone.scm b/examples/doctests-testone.scm
--- a/examples/doctests-testone.scm
+++ b/examples/doctests-testone.scm
@@ -1,13 +1,14 @@
#!/usr/bin/env sh
+# -*- scheme -*-
exec guile -L $(dirname $(dirname $(realpath "$0"))) -s "$0" "$@"
; !#
(import (examples doctests))
(define (foo)
- "(test 'foo
- (test-equal \"bar\" (foo)))
- "
+ #((tests
+ ('foo
+ (test-equal "bar" (foo)))))
"bar")
(doctests-testmod (current-module))
diff --git a/examples/doctests.scm b/examples/doctests.scm
--- a/examples/doctests.scm
+++ b/examples/doctests.scm
@@ -1,13 +1,55 @@
#!/usr/bin/env sh
+# -*- scheme -*-
exec guile -L $(dirname $(dirname $(realpath "$0"))) -e '(@@ (examples doctests) main)' -s "$0" "$@"
; !#
+;;; doctests --- simple testing by adding procedure-properties with tests.
+
+;;; Usage
+
+;; Add a tests property to a procedure to have simple unit tests.
+
+;; Simple tests:
+;;
+;; (define (A)
+;; #((tests (test-eqv 'A (A))
+;; (test-assert #t)))
+;; 'A)
+;;
+;; Named tests:
+;;
+;; (define (A)
+;; #((tests ('test1 (test-eqv 'A (A))
+;; (test-assert #t))
+;; ('test2 (test-assert #t))))
+;; 'A)
+;;
+;; Allows for docstrings:
+;;
+;; (define (A)
+;; "returns 'A"
+;; #((tests (test-eqv 'A (A))
+;; (test-assert #t)))
+;; 'A)
+
+;; For writing the test before the implementation, start with the test and #f:
+
+;; (define (A)
+;; #((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))
+
+
(define-module (examples doctests)
#:export (doctests-testmod))
(import (ice-9 optargs)
(ice-9 rdelim)
(ice-9 match)
+ (ice-9 pretty-print)
(oop goops)
(texinfo reflection))
@@ -35,19 +77,7 @@ exec guile -L $(dirname $(dirname $(real
(loop (string-drop s 1) (+ i 1))))))
(define (doctests-extract-from-string s)
- "Extract all test calls from a given string.
-
- This is an example test:
-
- (test 'mytest
- (define v (make-vector 5 99))
- (test-assert (vector? v))
- (test-eqv 99 (vector-ref v 2))
- (vector-set! v 2 7)
- (test-eqv 7 (vector-ref v 2)))
- (test 'mytest2
- (test-assert #t))
-"
+ "Extract all test calls from a given string."
(let lp
((str s)
(tests (list)))
@@ -65,50 +95,85 @@ exec guile -L $(dirname $(dirname $(real
(λ () (read)))
tests))))))))
+(define (subtract a b)
+ "Subtract B from A."
+ #((tests (test-eqv 3 (subtract 5 2))))
+ (- a b))
+
(define (doctests-testmod mod)
- "Execute all doctests in the current module"
+ "Execute all doctests in the current module
+
+ This procedure provides an example test:"
+ #((tests
+ ('mytest
+ (define v (make-vector 5 99))
+ (test-assert (vector? v))
+ (test-eqv 99 (vector-ref v 2))
+ (vector-set! v 2 7)
+ (test-eqv 7 (vector-ref v 2)))
+ ('mytest2
+ (test-assert #t))))
+ ;; thanks to Vítor De Araújo: https://lists.gnu.org/archive/html/guile-user/2017-08/msg00003.html
(let*
((names (module-map (λ (sym var) sym) mod))
(filename
- (if (module-filename mod) (string-join (string-split (module-filename mod) #\/) "-")
+ (if (module-filename mod) (string-join (string-split (module-filename mod) #\/ ) "-")
(string-join (cons "._" (map symbol->string (module-name mod))) "-")))
- (docstrings
- (map (λ (x) (if (procedure? x) (procedure-documentation x)))
+ (doctests
+ (map (λ (x) (if (procedure? x) (procedure-property x 'tests)))
(map (λ (x) (module-ref mod x)) names))))
(let loop
((names names)
- (docstrings docstrings))
- (when (not (null? docstrings))
- (when (string? (car docstrings))
- (let*
- ((name (car names))
- (docstring (car docstrings)))
- (let loop-tests
- ((doctests (doctests-extract-from-string (car docstrings))))
- (when (and (list? doctests) (not (null? doctests)))
- (let*
- ((doctest (car doctests))
- (testid
- (if (not (list? doctest))
- #f
- (string-join (list filename (symbol->string name) (symbol->string (primitive-eval (car (cdr doctest)))))
- "--")))
- (cleaned
- (if (not (list? doctest))
- '#f
- (append
- (cons 'begin
- (cons '(import (srfi srfi-64))
- (cons
- (list 'test-begin testid)
- (cdr (cdr doctest)))))
- (list (list 'test-end testid))))))
- (when cleaned
- (let ()
- (eval cleaned mod))
- (newline))
- (loop-tests (cdr doctests)))))))
- (loop (cdr names) (cdr docstrings))))))
+ (doctests doctests))
+ ;; pretty-print doctests
+ ;; newline
+ (when (pair? doctests)
+ (let*
+ ((name (car names))
+ (doctest (car doctests)))
+ (let loop-tests
+ ((doctest doctest))
+ (when (and (pair? doctest) (car doctest) (pair? (car doctest)))
+ ;; pretty-print : car doctest
+ ;; newline
+ (let*
+ (
+ (testid
+ (match doctest
+ (((('quote id) tests ...) moretests ...)
+ (string-join (list filename (symbol->string name) (symbol->string id))
+ "--"))
+ ((tests ...)
+ (string-join (list filename (symbol->string name))
+ "--"))))
+ (body
+ (match doctest
+ (((('quote id) test tests ...) moretests ...)
+ (cons test tests))
+ ((tests ...)
+ tests)))
+ (cleaned
+ (cons 'begin
+ (cons '(import (srfi srfi-64))
+ (cons
+ (list 'test-begin (or testid ""))
+ (append
+ body
+ (list (list 'test-end (or testid "")))))))))
+ ;; pretty-print testid
+ ;; pretty-print body
+ ;; pretty-print cleaned
+ ;; newline
+ (when cleaned
+ (let ()
+ (eval cleaned mod))
+ (newline))
+ (match doctest
+ (((('quote id) tests ...) moretests ...)
+ (loop-tests moretests))
+ ((tests ...)
+ #t))))))
+ (loop (cdr names) (cdr doctests))))))
(define %this-module (current-module))
(define (main args)
diff --git a/examples/doctests.w b/examples/doctests.w
--- a/examples/doctests.w
+++ b/examples/doctests.w
@@ -1,15 +1,56 @@
#!/usr/bin/env sh
# -*- wisp -*-
-guile -L $(dirname $(dirname $(realpath "$0"))) -c '(import (wisp-scheme) (language wisp spec))'
+guile -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp spec))'
exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples doctests) main)' -s "$0" "$@"
; !#
+;;; doctests --- simple testing by adding procedure-properties with tests.
+
+;;; Usage
+
+;; Add a tests property to a procedure to have simple unit tests.
+
+;; Simple tests:
+;;
+;; (define (A)
+;; #((tests (test-eqv 'A (A))
+;; (test-assert #t)))
+;; 'A)
+;;
+;; Named tests:
+;;
+;; (define (A)
+;; #((tests ('test1 (test-eqv 'A (A))
+;; (test-assert #t))
+;; ('test2 (test-assert #t))))
+;; 'A)
+;;
+;; Allows for docstrings:
+;;
+;; (define (A)
+;; "returns 'A"
+;; #((tests (test-eqv 'A (A))
+;; (test-assert #t)))
+;; 'A)
+
+;; For writing the test before the implementation, start with the test and #f:
+
+;; (define (A)
+;; #((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))
+
+
define-module : examples doctests
. #:export : doctests-testmod
import : ice-9 optargs
ice-9 rdelim
ice-9 match
+ ice-9 pretty-print
oop goops
texinfo reflection
@@ -37,19 +78,7 @@ define : string-index s fragment
loop (string-drop s 1) (+ i 1)
define : doctests-extract-from-string s
- . "Extract all test calls from a given string.
-
- This is an example test:
-
- (test 'mytest
- (define v (make-vector 5 99))
- (test-assert (vector? v))
- (test-eqv 99 (vector-ref v 2))
- (vector-set! v 2 7)
- (test-eqv 7 (vector-ref v 2)))
- (test 'mytest2
- (test-assert #t))
-"
+ . "Extract all test calls from a given string."
let lp
: str s
tests : list
@@ -67,50 +96,85 @@ define : doctests-extract-from-string s
λ () : read
. tests
+define : subtract a b
+ . "Subtract B from A."
+ . #((tests (test-eqv 3 (subtract 5 2))))
+ - a b
+
define : doctests-testmod mod
- . "Execute all doctests in the current module"
+ . "Execute all doctests in the current module
+
+ This procedure provides an example test:"
+ . #((tests
+ ('mytest
+ (define v (make-vector 5 99))
+ (test-assert (vector? v))
+ (test-eqv 99 (vector-ref v 2))
+ (vector-set! v 2 7)
+ (test-eqv 7 (vector-ref v 2)))
+ ('mytest2
+ (test-assert #t))))
+ ;; thanks to Vítor De Araújo: https://lists.gnu.org/archive/html/guile-user/2017-08/msg00003.html
let*
: names : module-map (λ (sym var) sym) mod
filename
if (module-filename mod) (string-join (string-split (module-filename mod) #\/ ) "-")
string-join (cons "._" (map symbol->string (module-name mod))) "-"
- docstrings
- map (λ (x) (if (procedure? x) (procedure-documentation x)))
+ doctests
+ map (λ (x) (if (procedure? x) (procedure-property x 'tests)))
map (λ (x) (module-ref mod x)) names
let loop
: names names
- docstrings docstrings
- when : not : null? docstrings
- when : string? : car docstrings
- let*
- : name : car names
- docstring : car docstrings
- let loop-tests
- : doctests : doctests-extract-from-string : car docstrings
- when : and (list? doctests) : not : null? doctests
- let*
- : doctest : car doctests
- testid
- if : not : list? doctest
- . #f
- string-join : list filename (symbol->string name) : symbol->string : primitive-eval : car : cdr doctest
- . "--"
- cleaned
- if : not : list? doctest
- . '#f
- append
- cons 'begin
- cons '(import (srfi srfi-64))
- cons
- list 'test-begin testid
- cdr : cdr doctest
- list : list 'test-end testid
- when cleaned
- let :
- eval cleaned mod
- newline
- loop-tests : cdr doctests
- loop (cdr names) (cdr docstrings)
+ doctests doctests
+ ;; pretty-print doctests
+ ;; newline
+ when : pair? doctests
+ let*
+ : name : car names
+ doctest : car doctests
+ let loop-tests
+ : doctest doctest
+ when : and (pair? doctest) (car doctest) : pair? : car doctest
+ ;; pretty-print : car doctest
+ ;; newline
+ let*
+ :
+ testid
+ match doctest
+ : (('quote id) tests ...) moretests ...
+ string-join : list filename (symbol->string name) : symbol->string id
+ . "--"
+ : tests ...
+ string-join : list filename (symbol->string name)
+ . "--"
+ body
+ match doctest
+ : (('quote id) test tests ...) moretests ...
+ cons test tests
+ : tests ...
+ . tests
+ cleaned
+ cons 'begin
+ cons '(import (srfi srfi-64))
+ cons
+ list 'test-begin : or testid ""
+ append
+ . body
+ list : list 'test-end : or testid ""
+ ;; pretty-print testid
+ ;; pretty-print body
+ ;; pretty-print cleaned
+ ;; newline
+ when cleaned
+ let :
+ eval cleaned mod
+ newline
+ match doctest
+ : (('quote id) tests ...) moretests ...
+ loop-tests moretests
+ : tests ...
+ . #t
+ loop (cdr names) (cdr doctests)
define %this-module : current-module
define : main args
diff --git a/examples/newbase60.w b/examples/newbase60.w
--- a/examples/newbase60.w
+++ b/examples/newbase60.w
@@ -1,5 +1,6 @@
#!/usr/bin/env sh
# -*- wisp -*-
+guile -L $(dirname $(dirname $(realpath "$0"))) -c '(import (language wisp spec))'
exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples newbase60) main)' -s "$0" "$@"
; !#
diff --git a/wisp-scheme.w b/wisp-scheme.w
--- a/wisp-scheme.w
+++ b/wisp-scheme.w
@@ -276,7 +276,7 @@ define : wisp-scheme-read-chunk-lines po
; an error. This is stricter than the current wisp
; syntax definition. TODO: Fix the definition. Better
; start too strict. FIXME: breaks on lines with only
- ; underscores which should empty lines.
+ ; underscores which should be empty lines.
: and inunderscoreindent : and (not (equal? #\space next-char)) (not (equal? #\newline next-char))
throw 'wisp-syntax-error "initial underscores without following whitespace at beginning of the line after" : last indent-and-symbols
: equal? #\newline next-char
@@ -343,8 +343,8 @@ define : wisp-scheme-read-chunk-lines po
. currentsymbols
. emptylines
; | cludge to appease the former wisp parser
- ; | which had a problem with the literal comment
- ; v char.
+ ; | used for bootstrapping which has a
+ ; v problem with the literal comment char
: equal? (string-ref ";" 0) next-char
loop
. indent-and-symbols
@@ -457,7 +457,7 @@ define : wisp-propagate-source-propertie
append processed : list : wisp-propagate-source-properties line
cdr unprocessed
-define : wisp-scheme-indentation-to-parens lines
+define* : wisp-scheme-indentation-to-parens lines
. "Add parentheses to lines and remove the indentation markers"
when
and
@@ -532,7 +532,7 @@ define : wisp-scheme-indentation-to-pare
values processed unprocessed
begin ;; not yet used level! TODO: maybe throw an error here instead of a warning.
let : : linenumber : - (length lines) (length unprocessed)
- format (current-error-port) ";;; WARNING:~A: used lower but undefined indentation level (line ~A of the current chunk: ~S). This makes refactoring much more error-prone, therefore it might become an error in a later version of Wisp.\n" linenumber linenumber (cdr current-line)
+ format (current-error-port) ";;; WARNING:~A: used lower but undefined indentation level (line ~A of the current chunk: ~S). This makes refactoring much more error-prone, therefore it might become an error in a later version of Wisp.\n" (source-property current-line 'line) linenumber (cdr current-line)
loop
. processed
. unprocessed