1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
;;; ccwl --- Concise Common Workflow Language
;;; Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of ccwl.
;;;
;;; ccwl is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; ccwl is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with ccwl. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; A few useful utilities
;;; Code:
(define-module (ccwl utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:export (pairify
plist->alist
lambda**))
(define (pairify lst)
"Return a list of pairs of successive elements of LST."
(match lst
(() '())
((first second tail ...)
(cons (cons first second)
(pairify tail)))))
(define (plist->alist plist)
"Convert the property list PLIST to an association list. A property
list is a list of the form (#:key1 value1 #:key2 value2 ...)."
(map (match-lambda
((key . value)
(cons (keyword->symbol key) value)))
(pairify plist)))
(define* (group-keyword-arguments args #:optional (unary-keywords (list)))
"Group ARGS, a list of keyword arguments of arbitrary arity. Return
a list of unary keyword arguments. n-ary arguments are grouped
together into lists. Keywords that are to be treated as having unit
arity are listed in UNARY-KEYWORDS."
(match args
(((? (lambda (keyword)
(and (keyword? keyword)
(not (member keyword unary-keywords))))
this-keyword)
tail ...)
(let ((this-keyword-args tail (break keyword? tail)))
(cons* this-keyword
(apply list this-keyword-args)
(group-keyword-arguments tail unary-keywords))))
(((? (lambda (keyword)
(and (keyword? keyword)
(member keyword unary-keywords)))
this-keyword)
this-keyword-arg tail ...)
(cons* this-keyword this-keyword-arg
(group-keyword-arguments tail unary-keywords)))
((non-keyword _ ...)
(error "Invalid sequence of keywords arguments" args))
(() '())))
(define (plist-ref plist key)
"Return the value from the first entry in PLIST with the given KEY,
or #f if there is no such entry."
(match (find-tail (cut eq? key <>) plist)
((_ value . _) value)
(#f #f)))
;; TODO: Implement a define** for lambda** in the spirit of define*
;; for lambda*.
(define-syntax lambda**
(lambda (x)
"Define a lambda function that can have positional arguments
followed by unary and n-ary keyword arguments. Unary keyword arguments
are prefixed by #:key. n-ary keyword arguments are prefixed by
#:key*. For example:
(lambda** (a b #:key foo #:key* bar)
(list a b foo bar))
Here, a and b are positional arguments. foo is a unary keyword
argument. bar is an n-ary keyword argument. The above function could,
for example, be invoked as:
((lambda** (a b #:key foo #:key* bar)
(list a b foo bar))
1 2 #:foo 123 #:bar 1 2 3)
=> (1 2 123 (1 2 3))"
(syntax-case x ()
((_ args-spec body ...)
#`(lambda args
#,(let* ((positionals rest (break keyword? (syntax->datum #'args-spec)))
(grouped-rest (group-keyword-arguments rest))
(unary-arguments (or (plist-ref grouped-rest #:key)
(list)))
(nary-arguments (or (plist-ref grouped-rest #:key*)
(list))))
#`(apply (lambda* #,(datum->syntax x (append positionals
(cons #:key (append unary-arguments nary-arguments))))
body ...)
(let ((positionals rest (break keyword? args)))
(append positionals
(group-keyword-arguments
rest (list #,@(map (compose (cut datum->syntax x <>)
symbol->keyword)
unary-arguments))))))))))))
|
