blob: 09d7cd30920125ec6d4932616a4eb4e0dfd939fb (
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
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
|
;;; Sly
;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
;;; Copyright (C) 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This program 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.
;;;
;;; This program 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/>.
;;; Commentary:
;;
;; Miscellaneous helper procedures.
;;
;;; Code:
(define-module (sly utils)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
#:use-module (rnrs arithmetic bitwise)
#:use-module (sly agenda)
#:export (define-guardian
memoize
trampoline
chain* chain
list->vlist* vlist-ref*))
(define-syntax-rule (define-guardian name reaper)
"Define a new guardian called NAME and call REAPER when an object
within the guardian is GC'd. Reaping is ensured to happen from the
same thread that is running the game loop."
(begin
(define name (make-guardian))
(schedule-each
(lambda ()
(let reap ((obj (name)))
(when obj
(reaper obj)
(reap (name))))))))
(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-rule (trampoline proc)
(lambda args
(apply proc args)))
;; Handy macro for flattening nested procedure calls where the output
;; of an inner call is the last argument to the outer call.
(define-syntax chain*
(syntax-rules ()
((_ args (proc ...))
(apply proc ... args))
((_ args (proc ...) . rest)
(chain* (call-with-values
(lambda () (apply proc ... args))
list) . rest))))
(define-syntax-rule (chain arg (proc ...) . rest)
(chain* (list arg) (proc ...) . rest))
(define (list->vlist* lst)
"Convert LST and all sub-lists within to vlists."
(list->vlist
(map (match-lambda
((sub-lst ...)
(list->vlist* sub-lst))
(obj obj))
lst)))
(define (vlist-ref* vlist index . rest)
"Return the element at index INDEX ... in the nested vlist structure
VLIST."
(if (null? rest)
(vlist-ref vlist index)
(apply vlist-ref* (vlist-ref vlist index) rest)))
|
