(Arne Babenhauserheide)
2015-06-23: merge newbase60 and release. merge newbase60 and release.
diff --git a/.bugs/bugs b/.bugs/bugs
--- a/.bugs/bugs
+++ b/.bugs/bugs
@@ -40,3 +40,4 @@ breaks on empty files
wisp-scheme: breaks on lines with only underscores. These should be treated as empty lines. | owner:, open:False, id:e464b5ce49deb14a80f67d50c6d70043ca9bde25, time:1415124488.16
quote as only char in a line gets parenthized instead of becoming a paren-prefix. | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:eb7468387e90bb5d13f5a5d81c6f4a704f2ca0fb, time:1390326369.6
in the REPL output can be delayed by one line: Appears only when submitting the next command. | owner:, open:False, id:f1e42bbd4c17a2dec886c26d9c14e770bcff66d2, time:1415972414.48
+wisp-scheme: parser problem with dotted pair: use-modules : (ice-9 popen) #:select ((open-input-pipe . oip)) | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:ff078cba853c1a2fdbd41cf0228ad7920a642c0d, time:1428358435.75
diff --git a/.hgsigs b/.hgsigs
--- a/.hgsigs
+++ b/.hgsigs
@@ -18,3 +18,4 @@ eaf23f42b01382e4ab255abcd34e031b043e1f56
695e3f4ff4bd2512e2d963c5b21385415c3b6dc3 0 iJsEAAEIAAYFAlRb4xsACgkQ3M8NswvBBUiRugP41O3ZOBViEjB0y4smTiU/yju4b/xJczLBhbNM1ExKu/EB3oQkAPpZhnBQcOPz43TMl2Kk8QKJgFcgeHKQlT+ZyMxZ0j7/GOSBxTH2Q1x5SXwJlnJAdmSH7UE2i5btEsemjkqAuqOlkX+z7QIswFSv7yHoBVh/Qs9AvcY0cCKFYw==
fed7f4d46a41b0814c81eb08dcdb506b38321c61 0 iQEcBAABAgAGBQJUbMOkAAoJEKMv031G/7TThsYIALXZAJY4Z4n5Be6mTE/CRXE7g3GlDEBPwstnvUBNzXiM5dAQbLHUt71yRx+d2WxxRHxUfuWG8PgrO/beITdjWhwoaM0fhknPRIOZ3Sc3RSrtleTm9gx1DS6CW5sCQvmqRSdyYJlqS30oHiq/gPftmFq2CllrSZWblL+t+/BfBLfG26DN4jy/b0IN5J1qeoi4gP/FwQ3e8A1lUIznjzQa57BVGBc/kKA+pAy/yFAlFvukAOG0BbFGRe0K3Gj6xITLdxfrmndH/688jgefUp+7JhLZZkfIoFAWBosPRQ5a2zaB1YRtUMEKgvvA05UiyTLQdlME2d52X1sSKrS9p69sTUU=
36b8c0daff2cd8cadb73b0dcc19c16a60f5b58eb 0 iJwEAAEIAAYFAlUKBPEACgkQ3M8NswvBBUgDugP8C6yJk7LyLOFMGoKLmnBin1dc9uuaj7idhx24tjgLjxLoM06I6QxkWPSEoKgVUR01Euu0EbXaoJogAaOUlaUTZPeSeSAZStvTmXveWL4P1VIQoERy1hmia+tMPxQKXkXf5R0YRwdmiqOh1AoH8dVdkCsCfplBc3VGrdDN4caZP00=
+a8ea98c78d90ae3e1b4daaf4bab3e2a7a847a06f 0 iJwEAAEIAAYFAlUoSqEACgkQ3M8NswvBBUihJQP/XB8kHNEcsTj5pgBtMepmIX/3CmVaz6ZNgzhSzJSS1oz2DMbXPJh32QaDwRd5wCoNksD00ch7e9UWhTSZztI/yDY9KwZrTV/OIDFzIdfSsdDO4J0WNxHmgymHSfitCjHcgSvT/C9/mubhNECPrQQUx08FMnNiNvcmGpwVOwakNNw=
diff --git a/.hgtags b/.hgtags
--- a/.hgtags
+++ b/.hgtags
@@ -26,3 +26,4 @@ b7441736af4dc8f1a7df860d1b064e080a45e1a5
0e702c268e6fdc9c52f034b6553c940b09c16400 v0.8.0
8eaf023f5d3bc20ad4b795cde3a92e3b5c242dba v0.8.1
327acbae68ef4efbf77734f0ee20359ed559ce0d v0.8.2
+41c48043ca33bf47311a93d0545b13a0578c3cf0 v0.8.3
diff --git a/Changelog b/Changelog
deleted file mode 100644
--- a/Changelog
+++ /dev/null
@@ -1,32 +0,0 @@
-0.3.1
- * wisp.py: parentheses in comments no longer break the parser
- * wisp.py: inline " ' : " is turned into " '("
- * multithreaded-magic.w: New example: Easy multithreading.
- * hello-world-server.w: Show local time instead of UTC and be a
- bit more friendly.
-
-0.3
- * wisp-multiline.sh: started with emacs support. Not yet nice.
- * wisp.w: renamed to wisp-guile.w to show that it uses guile
- scheme.
- * wisp.w: started wisp in wisp. Does not work, yet.
- * hello-world-server.w: First actually running example code.
- * wisp-multiline.sh: directly execute the typed script in guile
- scheme. Robust shell-script commandline parsing.
- * Readme.txt: Note the license and add references and footnotes.
- * Readme.txt: Fix the examples and add a stdin-example with guile.
-
-0.2
- * wisp.py: got more resilient.
- * wisp.py: condense multiple inline : into multiple brackets
- without whitespace.
- * wisp.py: refactored into multiple distinct phases for easier
- maintainability.
- * wisp.py: allow escaping : and _ with \.
- * wisp.py: added websafe indent with _
- * wisp.py: a colon at the end of the line is interpreted as ()
- * wisp.py: don’t interpret wisp code in brackets or strings.
-
-0.1
- * wisp.py: first version.
- * Readme.txt: Added a readme.
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,7 @@
+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.
+
wisp 0.8.2 (2015-03-18):
- resolve REPL delayed output bug.
- forbid dot at the end of a line and as only symbol in a line to reserve them for future use.
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.2],
+AC_INIT([wisp], [0.8.3],
[arne_bab@web.de])
# Check for programs I need for my build
AC_CANONICAL_TARGET
diff --git a/examples/cli.w b/examples/cli.w
new file mode 100755
--- /dev/null
+++ b/examples/cli.w
@@ -0,0 +1,15 @@
+#!/usr/bin/env sh
+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 args
+ newline
+
+main '("foo")
+
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/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/tests/dotted-pair.scm b/tests/dotted-pair.scm
new file mode 100644
--- /dev/null
+++ b/tests/dotted-pair.scm
@@ -0,0 +1,3 @@
+(use-modules ((ice-9 popen) #:select ((open-input-pipe . oip))))
+
+
diff --git a/tests/dotted-pair.w b/tests/dotted-pair.w
new file mode 100644
--- /dev/null
+++ b/tests/dotted-pair.w
@@ -0,0 +1,1 @@
+use-modules : (ice-9 popen) #:select ((open-input-pipe . oip))
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-scheme.w b/wisp-scheme.w
--- a/wisp-scheme.w
+++ b/wisp-scheme.w
@@ -380,7 +380,11 @@ define : line-finalize line
line-strip-lone-colon
line-strip-continuation line
when : not : null? : source-properties line
- set-source-properties! l : source-properties line
+ catch #t
+ lambda ()
+ set-source-properties! l : source-properties line
+ lambda : key . arguments
+ . #f
. l
define : wisp-add-source-properties-from source target
@@ -400,6 +404,10 @@ define : wisp-propagate-source-propertie
cond
: and (null? processed) (not (pair? unprocessed)) (not (list? unprocessed))
. unprocessed
+ : and (pair? unprocessed) (not (list? unprocessed))
+ cons
+ wisp-propagate-source-properties (car unprocessed)
+ wisp-propagate-source-properties (cdr unprocessed)
: null? unprocessed
. processed
else