edge-table-storage.lisp

   1 ;;;;***************************************************************************
   2 ;;;;
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;;  Name:           edge-table-storage.lisp
   6 ;;;;  Purpose:        Store precompiled edge table for reversi
   7 ;;;;  Programer:      Kevin Rosenberg
   8 ;;;;  Date Started:   1 Nov 2001
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; Reversi users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;;***************************************************************************
  18
  19 (in-package #:reversi)
  20
  21 (defparameter *et-path* nil)
  22
  23 (eval-when (:load-toplevel :execute)
  24   (let ((precompiled-path (make-pathname
  25                            :directory '(:absolute "usr" "share" "common-lisp"
  26                                                   "source" "reversi")
  27                            :name "edge-table"
  28                            :type "dat")))
  29     (if (probe-file precompiled-path)
  30         (setq *et-path* precompiled-path)
  31       (setq *et-path* (make-pathname
  32                        :directory (pathname-directory *load-truename*)
  33                        :host (pathname-host *load-truename*)
  34                        :device (pathname-device *load-truename*)
  35                        :name "edge-table"
  36                        :type "dat"))))
  37
  38   (defun store-edge-table (et &optional (path *et-path*))
  39     (declare (type edge-table et))
  40     (with-open-file (stream path :direction :output
  41                             :if-exists :supersede)
  42       (print (length et) stream)
  43       (dotimes (i (length et))
  44         (declare (fixnum i))
  45         (print (aref et i) stream))))
  46
  47   (defun load-edge-table (&optional (path *et-path*))
  48     (when (probe-file path)
  49       (with-open-file (stream path :direction :input)
  50         (let* ((length (read stream))
  51                (et (make-array length :element-type 'fixnum)))
  52           (declare (type (simple-array fixnum (*)) et))
  53           (dotimes (i length)
  54             (declare (fixnum i))
  55             (setf (aref et i) (read stream)))
  56           et))))
  57
  58   (unless (probe-file *et-path*)
  59     (format *trace-output* ";; Recompiling edge-table, this make take several minutes")
  60     (store-edge-table (make-edge-table)))
  61
  62   (unless *edge-table*
  63     (setq *edge-table* (load-edge-table))))
  64
  65
  66
  67
  68