X-Git-Url: http://git.kpe.io/?p=reversi.git;a=blobdiff_plain;f=edge-table-storage.lisp;h=f8d3b1036ca665e30fb27ef32dd7b8fec9450075;hp=1d2d6e17f2ec1883c022a9e4026ca2dceb6fecf9;hb=HEAD;hpb=1758cfb593196dd65c70199aa1ebd90cbd6e7ee5 diff --git a/edge-table-storage.lisp b/edge-table-storage.lisp index 1d2d6e1..f8d3b10 100644 --- a/edge-table-storage.lisp +++ b/edge-table-storage.lisp @@ -1,59 +1,64 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: edge-table-storage.lisp ;;;; Purpose: Store precompiled edge table for reversi ;;;; Programer: Kevin Rosenberg ;;;; Date Started: 1 Nov 2001 ;;;; -;;;; $Id: edge-table-storage.lisp,v 1.2 2002/10/25 09:23:39 kevin Exp $ +;;;; $Id$ ;;;; -;;;; This file is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; 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) - -(eval-when (:compile-toplevel :load-toplevel :execute) +(in-package #:reversi) - (defparameter *et-path* nil) +(defparameter *et-path* nil) - (if *load-truename* +(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")) - (setq *et-path* (make-pathname - :directory '(:absolute "usr" "share" "common-lisp" - "source" "reversi" "data") - :name "edge-table" - :type "dat"))) - - (defun store-edge-table (et &optional (path *et-path*)) + :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*)) + (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)))) - + (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))))