;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: edge-table-storage.cl
+;;;;
+;;;; Name: edge-table-storage.lisp
;;;; Purpose: Store precompiled edge table for reversi
-;;;; Programer: Kevin M. Rosenberg, M.D.
+;;;; Programer: Kevin Rosenberg
;;;; Date Started: 1 Nov 2001
-;;;; CVS Id: $Id: edge-table-storage.lisp,v 1.1 2002/10/25 08:36:42 kevin Exp $
;;;;
+;;;; $Id$
+;;;;
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
+;;;;
+;;;; Reversi users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;;***************************************************************************
-(in-package :reversi)
+(in-package #:reversi)
(defparameter *et-path* nil)
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (:load-toplevel :execute)
+ (let ((precompiled-path (make-pathname
+ :directory '(:absolute "usr" "share" "common-lisp"
+ "source" "reversi")
+ :name "edge-table"
+ :type "dat")))
+ (if (probe-file precompiled-path)
+ (setq *et-path* precompiled-path)
+ (setq *et-path* (make-pathname
+ :directory (pathname-directory *load-truename*)
+ :host (pathname-host *load-truename*)
+ :device (pathname-device *load-truename*)
+ :name "edge-table"
+ :type "dat"))))
- (defun store-edge-table (et &optional (path *et-path*))
+ (defun store-edge-table (et &optional (path *et-path*))
+ (declare (type edge-table et))
(with-open-file (stream path :direction :output
- :if-exists :supersede)
+ :if-exists :supersede)
(print (length et) stream)
(dotimes (i (length et))
- (print (aref et i) stream))))
-
+ (declare (fixnum i))
+ (print (aref et i) stream))))
+
(defun load-edge-table (&optional (path *et-path*))
(when (probe-file path)
(with-open-file (stream path :direction :input)
- (let* ((length (read stream))
- (et (make-array length :element-type 'fixnum)))
- (dotimes (i length)
- (setf (aref et i) (read stream)))
- et))))
-
- (setq *et-path* (make-pathname :defaults *load-truename* :name nil :type nil))
-
+ (let* ((length (read stream))
+ (et (make-array length :element-type 'fixnum)))
+ (declare (type (simple-array fixnum (*)) et))
+ (dotimes (i length)
+ (declare (fixnum i))
+ (setf (aref et i) (read stream)))
+ et))))
+
(unless (probe-file *et-path*)
+ (format *trace-output* ";; Recompiling edge-table, this make take several minutes")
(store-edge-table (make-edge-table)))
-
+
(unless *edge-table*
(setq *edge-table* (load-edge-table))))