;;; Chickadee Game Toolkit
;;; Copyright (C) 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(define-module (chickadee utils)
  #:use-module (ice-9 match)
  #:export (file-extension
            absolute-file-name
            tmpdir
            memoize
            for-range))

(define (file-extension file-name)
  (match (string-split file-name #\.)
    ((_ ... ext) ext)))

(define (absolute-file-name file-name)
  (if (absolute-file-name? file-name)
      file-name
      (string-append (getcwd) "/" file-name)))

(define (tmpdir)
  (or (getenv "TMPDIR") "/tmp"))

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