figl/contrib.scm

   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)))