summaryrefslogtreecommitdiff
path: root/chickadee/utils.scm
blob: 8869e8dc8dedabb4533e129761d73865e7f20d46 (plain)
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
;;; Chickadee Game Toolkit
;;; Copyright (C) 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;;
;;; Chickadee 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.
;;;
;;; Chickadee 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 this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (chickadee utils)
  #:export (memoize
            for-range))

;; Written by Ludovic Courtès.  Taken from GNU Guix.
(define (memoize proc)
  "Return a memoizing version of PROC."
  (let ((cache (make-hash-table)))
    (lambda args
      (let ((results (hash-ref cache args)))
        (if results
            (apply values results)
            (let ((results (call-with-values (lambda () (apply proc args))
                             list)))
              (hash-set! cache args results)
              (apply values results)))))))

(define-syntax for-range
  (syntax-rules ()
    ((_ ((var end start inc)) body ...)
     (let* ((s start) ; evaluate start/end only once
            (e end)
            (reverse? (< e s))
            (start* (if reverse? e s))
            (end* (if reverse? s e))
            (inc* (abs inc)))
       (let loop ((var start*))
         (when (< var end*)
           body ...
           (loop (+ var inc*))))))
    ((_ ((var end start)) body ...)
     (for-range ((var end start 1)) body ...))
    ((_ ((var end)) body ...)
     (for-range ((var end 0 1)) body ...))
    ((_ ((var args ...) rest ...) body ...)
     (for-range ((var args ...))
       (for-range (rest ...)
         body ...)))))