Commit | Line | Data |
---|---|---|
ec48feec DH |
1 | ;;; figl |
2 | ;;; Copyright (C) 2013 Andy Wingo <wingo@pobox.com> | |
3 | ;;; Copyright (C) 2013 Daniel Hartwig <mandyke@gmail.com> | |
4 | ;;; | |
5 | ;;; Figl is free software: you can redistribute it and/or modify it | |
6 | ;;; under the terms of the GNU Lesser General Public License as | |
7 | ;;; published by the Free Software Foundation, either version 3 of the | |
8 | ;;; License, or (at your option) any later version. | |
9 | ;;; | |
10 | ;;; Figl is distributed in the hope that it will be useful, but WITHOUT | |
11 | ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY | |
12 | ;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General | |
13 | ;;; Public License for more details. | |
14 | ;;; | |
15 | ;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;; License along with this program. If not, see | |
17 | ;;; <http://www.gnu.org/licenses/>. | |
18 | ||
19 | ;;; Commentary: | |
20 | ;; | |
21 | ;; Small helpers that properly have no home, or are imported from | |
22 | ;; other sources. | |
23 | ;; | |
24 | ;;; Code: | |
25 | ||
26 | (define-module (figl contrib) | |
27 | #:use-module (ice-9 regex) | |
28 | #:use-module (srfi srfi-69) ; hash tables | |
29 | #:export (memoize) | |
30 | #:replace (string-split)) | |
31 | ||
32 | (define (memoize proc) | |
33 | (let ((table (make-hash-table))) | |
34 | (lambda args | |
35 | (apply values | |
36 | (hash-table-ref | |
37 | table | |
38 | args | |
39 | (lambda () | |
40 | (call-with-values | |
41 | (lambda () (apply proc args)) | |
42 | (lambda results | |
43 | (hash-table-set! table args results) | |
44 | results)))))))) | |
45 | ||
46 | ;; Based on code by Andy Wingo. Eventually something like this will | |
47 | ;; be included with Guile. | |
48 | (define (string-split str delimiter) | |
49 | (if (regexp? delimiter) | |
50 | (let ((ret (fold-matches | |
51 | delimiter str (cons '() 0) | |
52 | (lambda (m prev) | |
53 | (let ((parts (car prev)) | |
54 | (start (cdr prev))) | |
55 | (cons (cons (substring str start (match:start m)) | |
56 | parts) | |
57 | (match:end m))))))) | |
58 | (reverse (cons (substring str (cdr ret)) (car ret)))) | |
59 | ((@ (guile) string-split) str delimiter))) |