From cc5051e85c6491f54438ee62573953107c916fff Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 22 May 2014 21:18:01 -0400 Subject: Memoize uniform-location. * 2d/helpers.scm (memoize): New procedure. * 2d/shader.scm (uniform-location): memoize. (uniform-set!): Pass symbol instead of string. --- 2d/helpers.scm | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) (limited to '2d/helpers.scm') diff --git a/2d/helpers.scm b/2d/helpers.scm index 59633d6..4082377 100644 --- a/2d/helpers.scm +++ b/2d/helpers.scm @@ -1,5 +1,6 @@ ;;; guile-2d ;;; Copyright (C) 2013, 2014 David Thompson +;;; Copyright (C) 2014 Ludovic Courtès ;;; ;;; This program is free software: you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as @@ -28,7 +29,8 @@ #:use-module (2d game) #:export (any-equal? logand? - define-guardian)) + define-guardian + memoize)) (define (any-equal? elem . args) "Return #t if ELEM equals any of the elements in the list ARGS." @@ -51,3 +53,16 @@ same thread that is running the game loop." (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))))))) -- cgit v1.2.3