(Arne Babenhauserheide)
2015-06-23: merge no longer wrapping blocks in begin, wisp-mode without electric stable v0.8.4 merge no longer wrapping blocks in begin, wisp-mode without electric indent and examples newbase60 and cli.
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,15 @@
+wisp 0.8.4 (2015-06-23):
+- no longer wrap wisp blocks into begin. Fixes missing macro
+ definitions when executed as file.
+- any top-level form ends a wisp block. Required to avoid wrapping in
+ begin. In the REPL code is now executed when entering the first line
+ of the next top-level form.
+- new examples: newbase60 and cli.
+- known issue: To execute a procedure with shell-indirection, you have
+ to define a module.
+- wisp-mode: disable electric-indent-mode which reindented lines
+ wrongly when pressing enter.
+
wisp 0.8.3 (2015-04-10):
- add partial source-properties support: show line numbers in backtraces.
- d20world: start of experiement to plot the results.
diff --git a/configure.ac b/configure.ac
--- a/configure.ac
+++ b/configure.ac
@@ -1,7 +1,7 @@
dnl run `autoreconf -i` to generate a configure script.
dnl Then run ./configure to generate a Makefile.
dnl Finally run make to generate the project.
-AC_INIT([wisp], [0.8.3],
+AC_INIT([wisp], [0.8.4],
[arne_bab@web.de])
# Check for programs I need for my build
AC_CANONICAL_TARGET
diff --git a/docs/srfi-from-template.html b/docs/srfi-from-template.html
--- a/docs/srfi-from-template.html
+++ b/docs/srfi-from-template.html
@@ -32,6 +32,8 @@ subscribe to the list. You can access p
<li>Received: <a
href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-119/srfi-119.html?rev=1.1">2015/01/25</a></li>
<li>Draft: 2015/02/03-2015/04/03</li>
+ <li>Revised: <a
+ href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-119/srfi-119.html?rev=1.2">2015/03/12</a></li>
</ul>
@@ -61,24 +63,30 @@ It resolves a limitation of <a href="htt
Wisp expressions can include any s-expressions and as such provide backwards compatibility.
</p>
+<blockquote>
<table><tr><th>wisp</th><th>s-exp</th></tr><tr><td>
-<pre><b>define</b> : <i>hello</i> who
- <i>format</i> #t "Hello ~A!\n"
- . who
-<i>hello</i> "Wisp"
+<pre>
+<b>define</b> : <i>factorial</i> n
+__ <b>if</b> : <i>zero?</i> n
+____ . 1
+____ <i>*</i> n : <i>factorial</i> (- n 1)
+
+<i>display</i> : <i>factorial</i> 5
+<i>newline</i>
</pre>
+</blockqote>
</td><td>
-<pre>(<b>define</b> (<i>hello</i> who)
- (<i>format</i> #t "Hello ~A!\n"
- who))
-(<i>hello</i> "S-exp")
+<pre>
+(<b>define</b> (<i>factorial</i> n)
+ (<b>if</b> (<i>zero?</i> n)
+ 1
+ (<i>*</i> n (<i>factorial</i> (- n 1)))))
+
+(<i>display</i> (<i>factorial</i> 5))
+(<i>newline</i>)
</pre>
</td></tr></table>
-
-<H1>Issues</H1>
-
-<ul>
-<li>wisp-scheme: REPL: sometimes the output of a command is only shown after typing the next non-empty line.</li></ul>
+</blockquote>
<H1>Rationale</H1>
@@ -133,7 +141,7 @@ Wisp expressions can include any s-expre
<h2>Wisp example</h2>
-Since an example speaks more than a hundred explanations, the following shows wisp exploiting all its features - including curly-infix from <a href="http://srfi.schemers.org/srfi-105/srfi-105.html">SRFI 105</a>:
+Since an example speaks more than a hundred explanations, the following shows wisp exploiting all its features - including compatibility with curly-infix from <a href="http://srfi.schemers.org/srfi-105/srfi-105.html">SRFI 105</a>:
<blockquote>
<pre>
@@ -750,7 +758,7 @@ DEALINGS IN THE SOFTWARE.
<address>Editor: <a href="mailto:srfi-editors at srfi dot schemers dot org">Michael Sperber</a></address>
<!-- Created: Tue Sep 29 19:20:08 EDT 1998 -->
<!-- hhmts start -->
-Last modified: Tue Mar 11 21:25:26 MET 2015
+Last modified: Thu Mar 12 08:52:43 MET 2015
<!-- hhmts end -->
</body>
</html>
diff --git a/examples/cli.w b/examples/cli.w
new file mode 100755
--- /dev/null
+++ b/examples/cli.w
@@ -0,0 +1,16 @@
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples cli) main)' -s "$0" "$@"
+; !#
+
+define-module : examples cli
+ . #:use-module : ice-9 match
+
+define : main args
+ match args
+ : prog ; just the program name, empty call
+ display : car args
+ else
+ display args
+ newline
+
diff --git a/examples/ensemble-estimation.w b/examples/ensemble-estimation.w
--- a/examples/ensemble-estimation.w
+++ b/examples/ensemble-estimation.w
@@ -1,4 +1,5 @@
#!/usr/bin/env sh
+# -*- wisp -*-
exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples ensemble-estimation) main)' -s "$0" "$@"
; !#
diff --git a/examples/newbase60.w b/examples/newbase60.w
new file mode 100755
--- /dev/null
+++ b/examples/newbase60.w
@@ -0,0 +1,149 @@
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples newbase60) main)' -s "$0" "$@"
+; !#
+
+;; Encoding and decoding numbers in New Base 60 as defined by Tantek:
+;; http://tantek.pbworks.com/NewBase60
+
+;; Based on the very elegant implementation from Kevin Marks licensed under CC0:
+;; https://github.com/indieweb/newBase60py/blob/master/newbase60.py
+
+define-module : examples newbase60
+ . #:export : integer->sxg sxg->integer date->sxg sxg->date date->sxgepochdays sxgepochdays->yeardays yeardays->sxgepochdays
+ . #:use-module : srfi srfi-1
+
+define base60letters "0123456789ABCDEFGHJKLMNPQRSTUVWXYZ_abcdefghijkmnopqrstuvwxyz"
+define base60numbers
+ append
+ map cons (string->list base60letters) : iota : string-length base60letters
+ quote
+ : #\l . 1 ; typo lowercase l to 1
+ #\I . 1 ; typo capital I to 1
+ #\O . 0 ; typo capital O to 0
+
+define : positive-integer->sxg num
+ . "Convert a positive integer to Tanteks new base 60."
+ if : equal? 0 num
+ . "0"
+ let loop
+ : s '()
+ n num
+ if : equal? n 0
+ list->string s
+ loop
+ cons (string-ref base60letters (remainder n 60)) s
+ quotient n 60
+
+define : positive-sxg->integer string
+ . "Convert a positive new base 60 string into a positive integer."
+ let loop
+ : n 0
+ s string
+ cond
+ : equal? "" s
+ . n
+ else
+ loop
+ + : assoc-ref base60numbers : string-ref s 0
+ * n 60
+ string-drop s 1
+
+define : integer->sxg num
+ . "Convert an integer to Tanteks new base 60."
+ if : >= num 0
+ positive-integer->sxg num
+ string-append "-" : positive-integer->sxg : - num
+
+define : sxg->integer str
+ . "Convert a new base 60 string into an integer."
+ if : and (>= (string-length str) 1) (equal? #\- (string-ref str 0))
+ - : positive-sxg->integer : string-drop str 1
+ positive-sxg->integer str
+
+define : date->sxgepochdays year month day hour minute second
+ let
+ : tm : gmtime 0 ; initialize
+ set-tm:year tm : - year 1900
+ set-tm:mon tm month
+ set-tm:mday tm day
+ set-tm:hour tm hour
+ set-tm:min tm minute
+ set-tm:sec tm second
+ let*
+ : epochseconds : car : mktime tm "+0" ; 0: UTC
+ epochdays : quotient epochseconds : * 24 60 60
+ integer->sxg epochdays
+
+define : yeardays->sxgepochdays year yeardays
+ let
+ : tm : car : strptime "%Y %j" : string-join : map number->string : list year yeardays
+ let*
+ : epochseconds : car : mktime tm "+0" ; 0: UTC
+ epochdays : quotient epochseconds : * 24 60 60
+ integer->sxg epochdays
+
+define : sxgepochdays->yeardays str
+ . "Turn sexagesimal days since epoch into year (YYYY) and day of year (DDD)."
+ let*
+ : epochdays : sxg->integer str
+ epochseconds : * epochdays 24 60 60
+ tm : gmtime epochseconds
+ year : + 1900 : tm:year tm
+ yeardays : tm:yday tm
+ list year (+ yeardays 1)
+
+define : date->sxg year month day hour minute second
+ . "Convert a date into new base 60 format:
+ yyyymmdd hhmmss -> YYMD-hms (can extend till 3599)
+ "
+ format #f "~A-~A"
+ apply string-append
+ map integer->sxg
+ list year month day
+ apply string-append
+ map integer->sxg
+ list hour minute second
+
+define : sxg->date str
+ . "Convert a new base 60 date into a list:
+ YYMD-hms -> (year month day hour minute second)
+ "
+ let*
+ : centeridx : string-rindex str #\- ; rindex because the year could be negative
+ getstr : lambda (s di) : string : string-ref str : + centeridx di
+ let
+ : year : substring/read-only str 0 : - centeridx 2
+ month : getstr str -2
+ day : getstr str -1
+ hour : getstr str 1
+ minute : getstr str 2
+ second : getstr str 3
+ map sxg->integer
+ list year month day hour minute second
+
+define : main args
+ let
+ : help : lambda () : format #t "usage: ~A [integer | -d string | --datetime | --datetime year month day hour minute second | --help]\n" : list-ref args 0
+ cond
+ : or (= 1 (length args)) (member "--help" args)
+ help
+ : and (= 8 (length args)) : equal? "--datetime" : list-ref args 1
+ format #t "~A\n" : apply date->sxg : map string->number : drop args 2
+ : and (= 8 (length args)) : equal? "--sxgepochdays" : list-ref args 1
+ format #t "~A\n" : apply date->sxgepochdays : map string->number : drop args 2
+ : and (= 4 (length args)) : equal? "--sxgepochdays-from-yearday" : list-ref args 1
+ format #t "~A\n" : apply yeardays->sxgepochdays : map string->number : drop args 2
+ : and (= 2 (length args)) : equal? "--datetime" : list-ref args 1
+ let : : tm : localtime : current-time
+ format #t "~A\n" : apply date->sxg : list (+ 1900 (tm:year tm)) (+ 1 (tm:mon tm)) (tm:mday tm) (tm:hour tm) (tm:min tm) (tm:sec tm)
+ : and (= 3 (length args)) : equal? "--decode-datetime" : list-ref args 1
+ format #t "~A\n" : sxg->date : list-ref args 2
+ : and (= 3 (length args)) : equal? "--decode-sxgepochdays" : list-ref args 1
+ format #t "~A\n" : sxgepochdays->yeardays : list-ref args 2
+ : and (= 3 (length args)) : equal? "-d" : list-ref args 1
+ format #t "~A\n" : sxg->integer : list-ref args 2
+ : = 2 : length args
+ format #t "~A\n" : integer->sxg : string->number : list-ref args 1
+ else
+ help
diff --git a/examples/property.w b/examples/property.w
new file mode 100755
--- /dev/null
+++ b/examples/property.w
@@ -0,0 +1,29 @@
+#!/usr/bin/env sh
+# -*- wisp -*-
+exec guile -L $(dirname $(dirname $(realpath "$0"))) --language=wisp -e '(@@ (examples property) main)' -s "$0" "$@"
+; !#
+
+define-module : examples property
+ . #:export : main
+
+; FIXME: this does not work when called from guile, but it works when
+; first translating it to scheme and then calling the scheme file.
+
+; The following works:
+
+; guile ../wisp.scm property.w > property.scm; guile -e '(@@ (examples property) main)' -s property.scm
+
+define y 5
+define-syntax z
+ identifier-syntax : var y
+ : set! var val
+ set! y : + 1 val
+
+define : main args
+ write args
+ newline
+ write z
+ newline
+ set! z 5
+ write z
+ newline
diff --git a/guildhall-packages/newbase60.scm b/guildhall-packages/newbase60.scm
new file mode 100644
--- /dev/null
+++ b/guildhall-packages/newbase60.scm
@@ -0,0 +1,151 @@
+#!/usr/bin/env sh
+# -*- scheme -*-
+exec guile -e '(@@ (examples newbase60) main)' -s "$0" "$@"
+; !#
+
+;; Encoding and decoding numbers in New Base 60 as defined by Tantek:
+;; http://tantek.pbworks.com/NewBase60
+
+;; Based on the very elegant implementation from Kevin Marks licensed under CC0:
+;; https://github.com/indieweb/newBase60py/blob/master/newbase60.py
+
+(define-module (examples newbase60)
+ #:export (integer->sxg sxg->integer date->sxg sxg->date date->sxgepochdays sxgepochdays->yeardays yeardays->sxgepochdays)
+ #:use-module (srfi srfi-1))
+
+(define base60letters "0123456789ABCDEFGHJKLMNPQRSTUVWXYZ_abcdefghijkmnopqrstuvwxyz")
+(define base60numbers
+ (append
+ (map cons (string->list base60letters) (iota (string-length base60letters)))
+ (quote
+ ((#\l . 1 ); typo lowercase l to 1
+ (#\I . 1 ); typo capital I to 1
+ (#\O . 0 ))))); typo capital O to 0
+
+(define (positive-integer->sxg num)
+ "Convert a positive integer to Tanteks new base 60."
+ (if (equal? 0 num)
+ "0"
+ (let loop
+ ((s '())
+ (n num))
+ (if (equal? n 0)
+ (list->string s)
+ (loop
+ (cons (string-ref base60letters (remainder n 60)) s)
+ (quotient n 60))))))
+
+(define (positive-sxg->integer string)
+ "Convert a positive new base 60 string into a positive integer."
+ (let loop
+ ((n 0)
+ (s string))
+ (cond
+ ((equal? "" s)
+ n)
+ (else
+ (loop
+ (+ (assoc-ref base60numbers (string-ref s 0))
+ (* n 60))
+ (string-drop s 1))))))
+
+(define (integer->sxg num)
+ "Convert an integer to Tanteks new base 60."
+ (if (>= num 0)
+ (positive-integer->sxg num)
+ (string-append "-" (positive-integer->sxg (- num)))))
+
+(define (sxg->integer str)
+ "Convert a new base 60 string into an integer."
+ (if (and (>= (string-length str) 1) (equal? #\- (string-ref str 0)))
+ (- (positive-sxg->integer (string-drop str 1)))
+ (positive-sxg->integer str)))
+
+(define (date->sxgepochdays year month day hour minute second)
+ (let
+ ((tm (gmtime 0 ))); initialize
+ (set-tm:year tm (- year 1900))
+ (set-tm:mon tm month)
+ (set-tm:mday tm day)
+ (set-tm:hour tm hour)
+ (set-tm:min tm minute)
+ (set-tm:sec tm second)
+ (let*
+ ((epochseconds (car (mktime tm "+0" ))); 0: UTC
+ (epochdays (quotient epochseconds (* 24 60 60))))
+ (integer->sxg epochdays))))
+
+(define (yeardays->sxgepochdays year yeardays)
+ (let
+ ((tm (car (strptime "%Y %j" (string-join (map number->string (list year yeardays)))))))
+ (let*
+ ((epochseconds (car (mktime tm "+0" ))); 0: UTC
+ (epochdays (quotient epochseconds (* 24 60 60))))
+ (integer->sxg epochdays))))
+
+(define (sxgepochdays->yeardays str)
+ "Turn sexagesimal days since epoch into year (YYYY) and day of year (DDD)."
+ (let*
+ ((epochdays (sxg->integer str))
+ (epochseconds (* epochdays 24 60 60))
+ (tm (gmtime epochseconds))
+ (year (+ 1900 (tm:year tm)))
+ (yeardays (tm:yday tm)))
+ (list year (+ yeardays 1))))
+
+(define (date->sxg year month day hour minute second)
+ "Convert a date into new base 60 format:
+ yyyymmdd hhmmss -> YYMD-hms (can extend till 3599)
+ "
+ (format #f "~A-~A"
+ (apply string-append
+ (map integer->sxg
+ (list year month day)))
+ (apply string-append
+ (map integer->sxg
+ (list hour minute second)))))
+
+(define (sxg->date str)
+ "Convert a new base 60 date into a list:
+ YYMD-hms -> (year month day hour minute second)
+ "
+ (let*
+ ((centeridx (string-rindex str #\- )); rindex because the year could be negative
+ (getstr (lambda (s di) (string (string-ref str (+ centeridx di))))))
+ (let
+ ((year (substring/read-only str 0 (- centeridx 2)))
+ (month (getstr str -2))
+ (day (getstr str -1))
+ (hour (getstr str 1))
+ (minute (getstr str 2))
+ (second (getstr str 3)))
+ (map sxg->integer
+ (list year month day hour minute second)))))
+
+(define (main args)
+ (let
+ ((help (lambda () (format #t "usage: ~A [integer | -d string | --datetime | --datetime year month day hour minute second | --help]\n" (list-ref args 0)))))
+ (cond
+ ((or (= 1 (length args)) (member "--help" args))
+ (help))
+ ((and (= 8 (length args)) (equal? "--datetime" (list-ref args 1)))
+ (format #t "~A\n" (apply date->sxg (map string->number (drop args 2)))))
+ ((and (= 8 (length args)) (equal? "--sxgepochdays" (list-ref args 1)))
+ (format #t "~A\n" (apply date->sxgepochdays (map string->number (drop args 2)))))
+ ((and (= 4 (length args)) (equal? "--sxgepochdays-from-yearday" (list-ref args 1)))
+ (format #t "~A\n" (apply yeardays->sxgepochdays (map string->number (drop args 2)))))
+ ((and (= 2 (length args)) (equal? "--datetime" (list-ref args 1)))
+ (let ((tm (localtime (current-time))))
+ (format #t "~A\n" (apply date->sxg (list (+ 1900 (tm:year tm)) (+ 1 (tm:mon tm)) (tm:mday tm) (tm:hour tm) (tm:min tm) (tm:sec tm))))))
+ ((and (= 3 (length args)) (equal? "--decode-datetime" (list-ref args 1)))
+ (format #t "~A\n" (sxg->date (list-ref args 2))))
+ ((and (= 3 (length args)) (equal? "--decode-sxgepochdays" (list-ref args 1)))
+ (format #t "~A\n" (sxgepochdays->yeardays (list-ref args 2))))
+ ((and (= 3 (length args)) (equal? "-d" (list-ref args 1)))
+ (format #t "~A\n" (sxg->integer (list-ref args 2))))
+ ((= 2 (length args))
+ (format #t "~A\n" (integer->sxg (string->number (list-ref args 1)))))
+ (else
+ (help)))))
+
+
diff --git a/guildhall-packages/pkg-list.scm b/guildhall-packages/pkg-list.scm
new file mode 100644
--- /dev/null
+++ b/guildhall-packages/pkg-list.scm
@@ -0,0 +1,6 @@
+(package (newbase60 (0))
+ (synopsis "Implementation of Tanteks New Base 60")
+ (libraries
+ (scm -> "newbase60"))
+ (programs
+ (("newbase60.scm") -> "newbase60")))
diff --git a/wisp-mode.el b/wisp-mode.el
--- a/wisp-mode.el
+++ b/wisp-mode.el
@@ -49,6 +49,10 @@
; use this mode automatically
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.w\\'" . wisp-mode))
+;;;###autoload
+(add-hook 'wisp-mode-hook
+ (lambda ()
+ (electric-indent-local-mode -1)))
; see http://www.emacswiki.org/emacs/DerivedMode
diff --git a/wisp-reader.w b/wisp-reader.w
--- a/wisp-reader.w
+++ b/wisp-reader.w
@@ -14,6 +14,8 @@ define-module : language wisp spec
. #:use-module : wisp-scheme
. #:use-module : system base compile
. #:use-module : system base language
+ . #:use-module : language scheme compile-tree-il
+ . #:use-module : language scheme decompile-tree-il
. #:export : wisp
; Set locale to something which supports unicode. Required to avoid using fluids.
@@ -23,64 +25,26 @@ setlocale LC_ALL ""
;;; Language definition
;;;
-define : compile-scheme x e opts
- values x e e
-
-define : decompile-scheme x e opts
- values x e
-
-define wisp-pending-port : make-object-property
-
-; Code thanks to Mark Weaver
-; define : read-one-wisp-sexp port env
-; define : read-wisp-chunk
-; if : eof-object? : peek-char port
-; read-char port ; return eof: we’re done
-; let : : s : wisp2lisp : wisp-chunkreader port
-; set! : wisp-pending-port port
-; open-input-string s
-; try-pending
-; define : try-pending
-; let : : pending-port : wisp-pending-port port
-; if pending-port
-; let : : x : read pending-port
-; if : eof-object? x
-; read-wisp-chunk
-; . x
-; read-wisp-chunk
-; try-pending
-
-
define wisp-pending-sexps : list
define : read-one-wisp-sexp port env
- define : wisp-scheme-read-chunk-env
- cond
- : eof-object? : peek-char port
- read-char port ; return eof: we’re done
- else
- set! wisp-pending-sexps
- append wisp-pending-sexps : wisp-scheme-read-chunk port
- try-pending
- define : try-pending
- if : null? wisp-pending-sexps
- wisp-scheme-read-chunk-env
- let
- : sexp : car wisp-pending-sexps
- pending wisp-pending-sexps
- set! wisp-pending-sexps : list ; : cdr wisp-pending-sexps
- ; write : cons 'begin pending
- if : = 1 : length pending
- car pending
- cons 'begin pending
- try-pending
+ cond
+ : eof-object? : peek-char port
+ read-char port ; return eof: we’re done
+ else
+ let : : chunk : wisp-scheme-read-chunk port
+ cond
+ : not : null? chunk
+ car chunk
+ else
+ . #f
define-language wisp
. #:title "Wisp Scheme Syntax. See SRFI-119 for details. THIS IS EXPERIMENTAL, USE AT YOUR OWN RISK"
; . #:reader read-one-wisp-sexp
. #:reader : lambda (port env) : let ((x (read-one-wisp-sexp port env))) x
- . #:compilers `((scheme . ,compile-scheme))
- . #:decompilers `((scheme . ,decompile-scheme))
+ . #:compilers `((tree-il . ,compile-tree-il))
+ . #:decompilers `((tree-il . ,decompile-tree-il))
. #:evaluator : lambda (x module) : primitive-eval x
. #:printer write ; TODO: backtransform to wisp? Use source-properties?
. #:make-default-environment
diff --git a/wisp-scheme.w b/wisp-scheme.w
--- a/wisp-scheme.w
+++ b/wisp-scheme.w
@@ -1,4 +1,5 @@
#!/bin/bash
+# -*- wisp -*-
exec guile -L . --language=wisp -s "$0" "$@"
; !#
@@ -209,16 +210,20 @@ define : wisp-scheme-read-chunk-lines po
currentindent 0
currentsymbols '()
emptylines 0
- if : <= 2 emptylines ; the chunk end has to be checked
- ; before we look for new chars in the
- ; port to make execution in the REPL
- ; after two empty lines work
- ; (otherwise it shows one more line).
+ cond
+ : >= emptylines 2 ; the chunk end has to be checked
+ ; before we look for new chars in the
+ ; port to make execution in the REPL
+ ; after two empty lines work
+ ; (otherwise it shows one more line).
. indent-and-symbols
+ else
let : : next-char : peek-char port
cond
: eof-object? next-char
append indent-and-symbols : list : append (list currentindent) currentsymbols
+ : and inindent (zero? currentindent) (not incomment) (not (null? indent-and-symbols)) (not inunderscoreindent) (not (or (equal? #\space next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) next-char)))
+ append indent-and-symbols ; top-level form ends chunk
: and inindent : equal? #\space next-char
read-char port ; remove char
loop