load-act-r-6.lisp 29.1 KB
Newer Older
1 2
;;;  -*- mode: LISP; Syntax: COMMON-LISP;  Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
root's avatar
root committed
3
;;;
4 5 6
;;; Author      : Dan Bothell
;;; Copyright   : (c) 2004 Dan Bothell
;;; Availability: Covered by the GNU LGPL, see LGPL.txt
root's avatar
root committed
7
;;; Address     : Department of Psychology
8 9 10
;;;             : Carnegie Mellon University
;;;             : Pittsburgh, PA 15213-3890
;;;             : db30@andrew.cmu.edu
root's avatar
root committed
11 12
;;;
;;;
13
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
root's avatar
root committed
14
;;;
15 16
;;; Filename    : load-act-r-6.lisp
;;; Version     : 1.0
root's avatar
root committed
17
;;;
18
;;; Description : Top level loader for the whole ACT-R 6 system.
root's avatar
root committed
19
;;;
20 21 22 23 24 25 26 27 28
;;; Bugs        : ???
;;;
;;; To do       : [-] Test in a variety of Lisps for issues with the
;;;             :     logical hostname stuff.
;;;             : [ ] Now, look into using the clisp version in other
;;;             :     lisps because it seems cleaner/more generic than
;;;             :     the ones I put toghether...
;;;             : [x] Use compile-file-pathname instead of always adding a new
;;;             :     entry for *.fasl-pathname*.
root's avatar
root committed
29
;;;
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
;;; ----- History -----
;;;
;;; 2004.10.26 Dan
;;;             : Creation.
;;;             :
;;;             : Realized that require doesn't compile things automatically
;;;             : in all cases, so added my own require-compiled that does.
;;; 2004.12.10 Dan
;;;             : Fixed the make-package for the packaged version (for use
;;;             : with ACL at least).
;;;             : Reduced the lines to max of 80 chars.
;;; 2005.01.02 Dan
;;;             : Changed it so that it loads the "core modules" in a specific
;;;             : order and then all other modules.
;;; 2005.01.12 Dan
;;;             : * Added the tools directory to the set.
;;; 2005.01.23 Dan
;;;             : * Fixed the Lispworks binary extension check. Don't think it
;;;             :   still needs the old one...
;;; 2005.01.29 Dan
;;;             : * Added a feature check into compile-and-load to force it
;;;             :   to recompile if :actr-recompile is on the features list.
;;; 2005.02.01 Dan
;;;             : * This time, the Lispworks feature checks should be set
;;;             :   properly for OSX (thanks to Chris Sims).
;;; 2005.02.25 Dan
;;;             : * Removed the ~\newline usages because that causes problems
;;;             :   when a Lisp only wants to see native new lines there.
;;; 2005.04.14 Dan
;;;             : * Changed compile-and-load so that it throws an error if the
;;;             :   file it is passed has a non-"lisp" extension. - need to
;;;             :   verify that in other Lisps to make sure it works right.
;;; 2005.07.07 Dan
;;;             : * Fixed the packaged loading for Lispworks now too.
;;; 2005.08.10 Dan
;;;             : * Added a new directory to the set (commands) in place of
;;;             :   where modules was and then moved modules to after the
;;;             :   devices.
;;;             : * Now, there's basically a directory to auto-load in all
root's avatar
root committed
69
;;;             :   resonable locations, and I can better distribute files
70 71 72 73 74 75 76 77 78 79 80 81 82
;;;             :   that were all jammed into tools.
;;;             : * Updated the version to 1.0.
;;; 2005.08.16 Dan
;;;             : * Added a flag to indicate whether things have been loaded
;;;             :   previously or not and actually throw an error if this
;;;             :   file is attempted to be loaded more than once.
;;; 2005.09.16 Dan
;;;             : * Added the appropriate feature checks to work "right" with
;;;             :   ACL 7's IDE i.e. load the devices and package things in
;;;             :   cg-user when necessary.
;;; 2005.10.18 Dan
;;;             : * Added the logical host setup for CMUCL.
;;;             : * Moved the smart-load function here and generalized it so
root's avatar
root committed
83
;;;             :   that framework and core-modules don't need to have
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
;;;             :   their own special versions.
;;;             : * Also converted those specific loaders to essentially just
;;;             :   file lists now.
;;; 2005.11.01 Dan
;;;             : * Added a new compile-and-load so that things can be loaded
;;;             :   into MCL 5/5.1 (the versions that have the split open/load
;;;             :   Mac/Unix file menu options) without having to convert all
;;;             :   the files first.  This file needs to be loaded as a Unix
;;;             :   file and the rest should take care of itself.
;;; 2005.11.07 Dan
;;;             : * Realized that since the environment is loaded from tools
;;;             :   that there's no way to add patches to the environment
;;;             :   in an "auto load" directory because things in tools may
;;;             :   be loaded before the environment.  So, I've added yet
;;;             :   another directory from which files are loaded automatically.
;;;             :   The other-files directory is now scanned and .lisp files
;;;             :   are loaded as the last step of the load process.
;;; 2005.12.13 Dan
;;;             : * Changed the logical host setup for ACL because it turns
;;;             :   out that the host-namestring always ends up nil and doesn't
;;;             :   actually capture the drive info which causes problems if
;;;             :   the ACT-R sources are on a different drive than the ACL
;;;             :   assumed default.
;;; 2006.01.04 Dan
;;;             : * Added the switches so that it'll load under CMUCL in OS X
;;;             :   (with ppc).
;;; 2006.06.29 Dan
root's avatar
root committed
111 112
;;;             : * Added components provided by Don Morrison to allow it to be
;;;             :   loaded into CLisp v2.38 - the CLisp logical host, tighter
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
;;;             :   handling of the logical pathnames in general (other Lisps
;;;             :   didn't mind logical namestrings in places where a pathname
;;;             :   designator was required), and a shadowing of the CLisp
;;;             :   execute function.
;;; 2006.08.31 Dan
;;;             : * Replaced the *already-loaded-act-r-6-files* variable as
;;;             :   the reloading test with a feeature check for :act-r-6.0
;;;             :   which is now placed on the *features* list.
;;; 2007.01.17 Dan
;;;             : * Added the support necessary to load into SBCL.
;;;             : * Required changing all calls to logical-pathname in the
;;;             :   directory calls to translate-logical-pathname which should
;;;             :   work for all Lisps (SHOULD!).
;;;             : * NOTE that this doesn't work with SBCL 1.0 under Windows
;;;             :   because a bug in their directory command doesn't
;;;             :   recognize the wildcards but they've addressed that so future
;;;             :   versions of SBCL for Windows should work.
;;; 2007.02.02 Dan
;;;             : * Changed the uses for the packaged-actr so that all Lisps
;;;             :   use "COMMON-LISP" - should work, but this is still an
;;;             :   an experimental feature.
;;; 2007.02.05 Dan
;;;             : * Added the hack for the broken directory command in SBCL for
;;;             :   Windows so that it can load all of the files now.
;;; 2007.02.26 Dan
;;;             : * Added an appropriate fasl extension for LispWorks 5 on
;;;             :   x86 Macs.
;;; 2007.07.24 Dan
;;;             : * Finally added the right extension for LispWorks 5 for
;;;             :   Windows.
;;; 2007.08.03 Dan
;;;             : * Fixed the feature checks so that LispWorks 5 gets the
;;;             :   right value for Windows...
;;; 2007.09.10 Dan
;;;             : * Putting the LispWorks device file pointers in to allow use
;;;             :   of the beta device interface.
;;; 2008.06.09 Dan
;;;             : * Added yet another LispWorks entry for compiled file types
;;;             :   to cover the LW 5 unix names.  Probably about time to try
;;;             :   getting something that's robust using compile-file-pathname
;;;             :   instead...
;;; 2008.06.10 Dan
;;;             : * Trying a version that uses compile-file-pathname to try
;;;             :   to set the fasl name "automatically".
;;; 2010.03.09 Dan
;;;             : * Changed the openmcl logical setting to the 'generic' one
;;;             :   to fix problems with different "drives" under Windows.
;;; 2010.03.11 mdb
;;;             : * Changed MCL-specific code to not load CFBundle when running
;;;             :   under MCL 5.2.
;;; 2010.11.02 Dan
;;;             : * Added ABCL to the list for logical translation.
;;; 2011.04.28 Dan
;;;             : * Define *file-list* here and just set it in the other loaders.
root's avatar
root committed
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
;;; 2012.01.04 Dan
;;;             : * Added another directory to the tree: user-loads.  That will
;;;             :   always go last and there will never be any distributed files
;;;             :   in it.  The .lisp files in it will be loaded in order based
;;;             :   on file name and is for users to add initialization or model
;;;             :   files to as needed.
;;;             : * Removed the old info under general docs.
;;; 2012.05.07 Dan
;;;             : * Make the ACL device support dependent on the Windows version
;;;             :   only and print a warning for the others.
;;; 2012.08.24 Dan
;;;             : * Added the switches to load the new ccl-cocoa device and
;;;             :   removed the mcl device.
;;; 2013.08.09 Dan
;;;             : * Fixed a problem with the shadowing of functions in SBCL and
;;;             :   CLisp when the current package wasn't :cg-user.
;;; 2013.10.07 Dan
;;;             : * Added another feature switch to be tested :actr-fast.  When
;;;             :   it's on the features list set the optimize settings for faster
;;;             :   compiled code.
;;; 2013.12.19 Dan
;;;             : * Added an :ecl switch to the logical path definitions.
;;; 2014.06.16 Dan
;;;             : * Added a use :ccl to the :act-r package for CCL.
;;; 2014.07.15 Dan
;;;             : * Added the additional keyword :ACT-R to the features list as
;;;             :   a general indicator that some version of ACT-R has been
;;;             :   loaded.
195 196 197
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; General Docs:
root's avatar
root committed
198
;;;
199 200 201 202 203
;;; Using logical pathnames a directory structure for ACT-R 6 can be created
;;; that allows users to add or remove files from a specific directory within
;;; the system, and through the use of require and provide also remove the
;;; need to edit a "load order" file.
;;;
root's avatar
root committed
204
;;; See the reference manual for details about the directories provided.
205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Public API:
;;;
;;; The logical hostname "ACT-R6" can be used as a relative reference for the
;;; directory where the ACT-R 6 folders are located.
;;;
;;;
;;; require-compiled (code-module pathname)
;;;
;;; code-module is a string that designates some code that needs to be loaded
;;;             which should have a corresponding (provide code-module)
;;; pathname is the pathname to where code-module can be found.
;;;
;;; Similar to the function require this will determine if the requested
;;; code-module has been loaded and if not will compile and load the file
;;; specified by pathname.  This differs from the normal require function
;;; in that the pathname is mandatory and it does not search through any
;;; implementation defaults to find the code-module.  However, it does still
;;; depend on a provide call existing in the code-module file so that
;;; it only loads the necessary file the first time it is required.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Design Choices:
root's avatar
root committed
230
;;;
231 232 233 234 235 236 237 238 239
;;; The idea is for a system where people can just drop in new modules without
;;; having to edit or change any of the existing code.  In practice, that
;;; may not work all the time (with things like name conflicts) but should
;;; be useable.  Name conflicts could probably be eliminated through some
;;; sort of module packaging scheme, but that seems to complicate module
;;; creation and could lead to some potentially nasty debugging issues.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
root's avatar
root committed
240
;;;
241 242 243
;;; The code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

root's avatar
root committed
244
;;----Added by Chris Dancy, xml libraries needed for physiology module
245 246 247 248 249 250 251
;;Load sxml files
(load (merge-pathnames "sxml/package.lisp" *LOAD-TRUENAME*))
(load (merge-pathnames "sxml/dom.lisp" *LOAD-TRUENAME*))
(load (merge-pathnames "sxml/lxml-dom.lisp" *LOAD-TRUENAME*))
(load (merge-pathnames "sxml/sxml-dom.lisp" *LOAD-TRUENAME*))
(load (merge-pathnames "sxml/xml.lisp" *LOAD-TRUENAME*))
(load (merge-pathnames "sxml/xml-struct-dom.lisp" *LOAD-TRUENAME*))
root's avatar
root committed
252
;;----
253 254


root's avatar
root committed
255 256
#+:packaged-actr (make-package :act-r
                               :use '("COMMON-LISP-USER"
257
                                      "COMMON-LISP"
root's avatar
root committed
258
                                      #+:ccl "CCL"
259 260 261 262 263 264 265 266
                                      #+:allegro "EXCL"
                                      #+:allegro-ide "COMMON-GRAPHICS-USER"
                                      #+:common-graphics "COMMON-GRAPHICS-USER"))


;;; Basically a hack for ACL 7 so that I don't have to touch every file!

(eval-when (:compile-toplevel :load-toplevel :execute)
root's avatar
root committed
267

268 269 270 271 272 273 274 275
  #+(and :allegro :ide (not :allegro-ide))
    (push :allegro-ide *features*))

#+:packaged-actr (in-package :act-r)
#+(and :clean-actr (not :packaged-actr) :ALLEGRO-IDE) (in-package :cg-user)
#-(or (not :clean-actr) :packaged-actr :ALLEGRO-IDE) (in-package :cl-user)


root's avatar
root committed
276 277
#+:act-r (error "Only one version of ACT-R should be loaded at a time.")
#-:act-r (progn (pushnew :act-r *features*) (pushnew :act-r-6.0 *features*))
278 279 280 281


;; Clisp has an implementation-specific function execute that conflicts with
;; the generic function execute in ACT-R, so shadow it
root's avatar
root committed
282
#+:clisp (eval `(defpackage ,(package-name *package*) (:shadow "EXECUTE")))
283 284 285 286 287 288

;; SBCL has a function called reset we need to shadow and there's an issue
;; with their defconstat because it throws an error if you compile and then
;; load a file (it's fine with the compiled file later, but that first time
;; is a problem).

root's avatar
root committed
289 290 291 292 293
#+(and :sbcl (not :win32))
  (eval `(defpackage ,(package-name *package*) (:shadow "RESET" "DEFCONSTANT")))
#+(and :sbcl :win32)
  (eval `(defpackage ,(package-name *package*) (:shadow "RESET" "DEFCONSTANT" "DIRECTORY")))

294 295 296 297 298 299 300
#+:sbcl (defmacro defconstant (name value &optional documentation)
          `(sb-c::%defconstant ',name ,value ',documentation (sb-c:source-location)))

;;; The Windows version of SBCL doesn't properly handle wild cards in the
;;; directory command so this hacks around that for now sufficiently to load
;;; the ACT-R files...

root's avatar
root committed
301
#+(and :sbcl :win32)
302 303 304 305 306 307 308 309 310
(eval-when (:load-toplevel :execute)
  (defun directory (pathname &key)
    ;(format t "Calling the new directory for ~S~%" pathname)
    (if (not (string= (pathname-type pathname) "*"))
        (let* ((new-path (make-pathname :host (pathname-host pathname)
                                        :device (pathname-device pathname)
                                        :directory (pathname-directory pathname)
                                        :defaults "*.*"))
               (new-val (cl::directory new-path))
root's avatar
root committed
311
               (res (remove-if-not (lambda (x)
312 313 314 315 316
                                     (string-equal (pathname-type x) (pathname-type pathname)))
                                   new-val)))
          ;(format t "Returning ~S from directory of new-path: ~s which returns ~s.~%" res new-path new-val)
          res)
      (cl::directory pathname))))
root's avatar
root committed
317

318 319 320 321 322 323 324 325 326 327 328 329 330 331 332
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create the logical host "ACT-R6" relative to the current location

#+:allegro (setf (logical-pathname-translations "ACT-R6")
             (list (list "**;*.*" (let ((name (namestring *load-truename*))
                                        (file (file-namestring *load-truename*)))
                                    (subseq name 0 (- (length name) (length file)))))))


#+:digitool (setf (logical-pathname-translations "ACT-R6")
  (list (list "**;*.*" (concatenate 'string
                         (host-namestring *load-truename*)
                         (directory-namestring *load-truename*) "**:"))))

#+:lispworks (setf (logical-pathname-translations "ACT-R6")
root's avatar
root committed
333
               (list (list "**;*.*"
334 335
                           (concatenate 'string
                             (format nil "~A" (make-pathname
root's avatar
root committed
336
                                               :host
337
                                               (pathname-host *load-truename*)
root's avatar
root committed
338 339 340
                                               :directory
                                               (pathname-directory
                                                *load-truename*)))
341 342 343 344
                             "**/*.*"))))

;; just copied the lispworks one for now...
#+:cmu (setf (logical-pathname-translations "ACT-R6")
root's avatar
root committed
345
               (list (list "**;*.*"
346 347
                           (concatenate 'string
                             (format nil "~A" (make-pathname
root's avatar
root committed
348
                                               :host
349
                                               (pathname-host *load-truename*)
root's avatar
root committed
350 351 352
                                               :directory
                                               (pathname-directory
                                                *load-truename*)))
353 354
                             "**/*.*"))))

root's avatar
root committed
355
#+(or :clisp :sbcl :openmcl :abcl :ecl) (setf (logical-pathname-translations "ACT-R6")
356 357 358 359 360 361 362
                      `(("**;*.*" ,(namestring (merge-pathnames "**/*.*" *load-truename*)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; define the file extension (the pathname type) for compiled and source files
;;; in the currently supported systems

(unless (boundp '*.lisp-pathname*)
root's avatar
root committed
363
  (defvar *.lisp-pathname*
364 365 366
      (make-pathname :type "lisp")))

(unless (boundp '*.fasl-pathname*)
root's avatar
root committed
367
  (defvar *.fasl-pathname*
368
      (let ((type (pathname-type (compile-file-pathname "dummy.lisp"))))
root's avatar
root committed
369
        (if (and type (not (string-equal type "lisp")))
370
          (make-pathname :type type)
root's avatar
root committed
371

372
        ;; If it can't figure it out automatically resort to predefined value
root's avatar
root committed
373

374 375 376 377 378 379 380 381 382 383 384 385 386
        #+:allegro (make-pathname :type "fasl")
        #+:sbcl (make-pathname :type "fasl")
        #+:clisp (make-pathname  :type "fas")
        #+(and :linux :cmu) (make-pathname :type "x86f")
        #+(and :ppc :cmu) (make-pathname :type "ppcf")
        #+(and :lispworks :win32 (not :lispworks5)) (make-pathname :type "fsl")
        #+(and :lispworks :win32 :lispworks5) (make-pathname :type "ofasl")
        #+(and :lispworks :unix (not :macosx) (not :lispworks5)) (make-pathname :type "ufsl")
        #+(and :lispworks :unix (not :macosx) :lispworks5) (make-pathname :type "ufasl")
        #+(and :lispworks :macosx (not :x86)) (make-pathname :type "nfasl")
        #+(and :lispworks :macosx :x86) (make-pathname :type "xfasl")))))


root's avatar
root committed
387 388 389 390 391 392 393 394 395
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; When :actr-fast is on the features list then set the switches for fastest
;;; compiled code.

#+:actr-fast (eval-when (:compile-toplevel :load-toplevel :execute)
               (proclaim '(optimize (speed 3) (safety 1) (space 0) (debug 0))))


396 397 398 399 400 401 402 403 404
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Define some functions for compiling and loading files

;;; compile-and-load (pathname)
;;;
;;; pathname a file pathname (or pathname string) if the file already
;;;          has a type specified, then it is ignored and the defaults
;;;          of lisp for source and system-dependent binary types are
;;;          used.
root's avatar
root committed
405
;;;
406 407
;;; If a source file (.lisp) exists for the specified pathname then if there
;;; is no binary file (determined by *.fasl-pathname*), the binary is
root's avatar
root committed
408 409
;;; older than the source file, or the feature :act-r-recompile is set then
;;; compile the source file into a binary and load it.
410 411 412 413 414 415
;;;
;;; Based on the smart-load function from the ACT-R loader.


;;; Specific loader for the newer MCL 5/5.1

root's avatar
root committed
416
#+(and :ccl-4.3.5 :ccl-5.0)
417 418 419 420 421 422 423 424 425
(defun compile-and-load (pathname)
  (when (pathname-type pathname) ;; throw away the type to allow for
                                 ;; the merging with a binary type
    (if (string-equal (pathname-type pathname) "lisp")
        (setf pathname (make-pathname :host (pathname-host pathname)
                                      :directory (pathname-directory pathname)
                                      :device (pathname-device pathname)
                                      :name (pathname-name pathname)))
      (error "To compile a file it must have a .lisp extension")))
root's avatar
root committed
426

427 428 429 430 431 432 433 434 435
  (let* ((srcpath (merge-pathnames pathname *.lisp-pathname*))
         (binpath (merge-pathnames pathname *.fasl-pathname*)))
    (unless (probe-file srcpath)
      (error "File ~S does not exist" srcpath))
    (when (or (member :actr-recompile *features*)
              (not (probe-file binpath))
              (> (file-write-date srcpath) (file-write-date binpath)))
      (compile-file srcpath :output-file binpath :external-format :unix))
    (load binpath)))
root's avatar
root committed
436 437

#-(and :ccl-4.3.5 :ccl-5.0)
438 439 440 441 442 443 444 445 446
(defun compile-and-load (pathname)
  (when (pathname-type pathname) ;; throw away the type to allow for
                                 ;; the merging with a binary type
    (if (string-equal (pathname-type pathname) "lisp")
        (setf pathname (make-pathname :host (pathname-host pathname)
                                      :directory (pathname-directory pathname)
                                      :device (pathname-device pathname)
                                      :name (pathname-name pathname)))
      (error "To compile a file it must have a .lisp extension")))
root's avatar
root committed
447

448 449 450 451 452 453 454 455 456
  (let* ((srcpath (merge-pathnames pathname *.lisp-pathname*))
         (binpath (merge-pathnames pathname *.fasl-pathname*)))
    (unless (probe-file srcpath)
      (error "File ~S does not exist" srcpath))
    (when (or (member :actr-recompile *features*)
              (not (probe-file binpath))
              (> (file-write-date srcpath) (file-write-date binpath)))
      (compile-file srcpath :output-file binpath))
    (load binpath)))
root's avatar
root committed
457

458 459 460 461


;;; SMART-LOAD      [Function]
;;; Date        : 99.12.21
root's avatar
root committed
462 463 464
;;; Description : Loads binary version of a specified file.  Of course, the
;;;             : said binary version might not exist or be older than the
;;;             : source version, in which case the source file is compiled
465 466 467 468 469 470
;;;             : before loading.
;;;             : Updated to add an option parameter to determine whether
;;;             : to just warn of a missing file or to throw an error.


(defun smart-load (this-files-dir file &optional (error? nil))
root's avatar
root committed
471
  "Loads binary <file> in directory <this-files-dir> or compiles and loads
472
   source version"
root's avatar
root committed
473
  (let* ((srcpath (merge-pathnames
474 475 476 477
                   (merge-pathnames file *.lisp-pathname*)
                   this-files-dir))
         )
    (if (not (probe-file srcpath))
root's avatar
root committed
478
        (if error?
479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501
            (error "File ~S does not exist" srcpath)
          (format *error-output* "File ~S does not exist" srcpath)))
    (compile-and-load srcpath)))


;;; require-compiled (code-module pathname)
;;;
;;; code-module is a string that designates some code that needs to be loaded
;;;             which should have a corresponding (provide code-module) in it
;;; pathname is the pathname to where that code-module can be found (including
;;;          the file's name).
;;;
;;; Similar to the function require this will determine if the requested
;;; code-module has been loaded and if not will compile and load the file
;;; specified by pathname.  This differs from the normal require function
;;; in that the pathname is mandatory and it does not search through any
;;; implementation defaults to find the code-module.  However, it does still
;;; depend on a provide call existing in the code-module file so that
;;; it only loads the necessary file the first time it is required.

(defmacro require-compiled (code-module pathname)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (unless (member ,code-module *modules* :test #'string=)
root's avatar
root committed
502
       (compile-and-load (translate-logical-pathname ,pathname)))))
503 504 505 506 507 508 509 510 511 512 513 514 515


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; load any special system support files here

#+(and :mcl (not :openmcl)) (require 'quickdraw)

#+(and :ccl-5.0 (not :ccl-5.2))
(when (osx-p)
  (load "ACT-R6:support;CFBundle.lisp"))

#+:allegro (when (or (eq :case-sensitive-lower *current-case-mode*)
                     (eq :case-sensitive-upper *current-case-mode*))
root's avatar
root committed
516 517
             (unless
                 (yes-or-no-p
518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533
                  "WARNING: you are using a case sensitive Lisp.  ACT-R may not load or run correctly.  Continue anyway?")
               (break)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Load the framework's loader file (it is order dependent)

(defvar *file-list*)

(smart-load (translate-logical-pathname "ACT-R6:framework;") "framework-loader.lisp")

(dolist (the-file *file-list*)
  (smart-load (translate-logical-pathname "ACT-R6:framework;") the-file t))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
root's avatar
root committed
534
;;; Load the core modules
535 536 537 538 539 540 541

(smart-load (translate-logical-pathname "ACT-R6:core-modules;") "core-loader.lisp")

(dolist (the-file *file-list*)
  (smart-load (translate-logical-pathname "ACT-R6:core-modules;") the-file))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
root's avatar
root committed
542
;;;
543 544 545 546 547 548 549
;;; First, load any additional extensions.

(dolist (file (directory (translate-logical-pathname "ACT-R6:commands;*.lisp")))
  (compile-and-load file))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
root's avatar
root committed
550
;;; Indicate that there is a device available so that it can be loaded
551 552 553 554 555 556
;;; When a new device is added it should be included with a switch below

(defvar *device-interface-pathname* nil)

;;; Here are the devices that are defined

root's avatar
root committed
557 558 559
#+(and :allegro-ide :mswindows) (setf *device-interface-pathname* "ACT-R6:devices;acl;")

#+(and :allegro-ide (not :mswindows)) (print-warning "Native ACL device not available for Mac or Linux versions because~%they lack the commands for controlling the mouse and keyboard as described here~%http://www.franz.com/support/documentation/6.2/doc/cggtk-relnotes.html#2.3~%")
560

root's avatar
root committed
561
;; #+:digitool (setf *device-interface-pathname* "ACT-R6:devices;mcl;")
562 563 564

#+:lispworks (setf *device-interface-pathname* "ACT-R6:devices;lw;")

root's avatar
root committed
565
#+(and :clozure :darwin :apple-objc :ccl-1.8) (setf *device-interface-pathname* "ACT-R6:devices;ccl-cocoa;")
566 567 568 569 570 571 572 573 574 575

;;; Load the virtual device

(compile-and-load (translate-logical-pathname "ACT-R6:devices;virtual;device.lisp"))
(compile-and-load (translate-logical-pathname "ACT-R6:devices;virtual;uwi.lisp"))

;;; Load any Lisp specific device that's defined

(when *device-interface-pathname*
  (if (probe-file (merge-pathnames *device-interface-pathname* "device.lisp"))
root's avatar
root committed
576
      (compile-and-load (merge-pathnames *device-interface-pathname*
577
                                         "device.lisp"))
root's avatar
root committed
578
    (format t
579 580 581
        "################~%#### No Device file found in ~S ####~%##############"
      *device-interface-pathname*))
  (if (probe-file (merge-pathnames *device-interface-pathname* "uwi.lisp"))
root's avatar
root committed
582
      (compile-and-load (merge-pathnames *device-interface-pathname*
583
                                         "uwi.lisp"))
root's avatar
root committed
584
    (format t
585 586
        "#################~%#### No uwi file found in ~S ####~%################"
      *device-interface-pathname*)))
root's avatar
root committed
587

588 589

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
root's avatar
root committed
590
;;; After the modules and devices files are done load any files in the
591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611
;;; modules, tools and then finally the other-files drectories.

(dolist (file (directory (translate-logical-pathname "ACT-R6:modules;*.lisp")))
  (compile-and-load file))

(dolist (file (directory (translate-logical-pathname "ACT-R6:tools;*.lisp")))
  (compile-and-load file))

(dolist (file (directory (translate-logical-pathname "ACT-R6:other-files;*.lisp")))
  (compile-and-load file))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Print a conformation message to let the user know ACT-R has been loaded
;;; along with the version numbers of all the modules.

(format t "~%##################################~%")
(mp-print-versions )
(format t "~%######### Loading of ACT-R 6 is complete #########~%")


root's avatar
root committed
612 613 614 615 616 617 618
(let ((d (directory (translate-logical-pathname "ACT-R6:user-loads;*.lisp"))))
  (when d
    (format t "~%######### Loading user files #########~%")
    (dolist (file (sort d 'string< :key (lambda (x) (string (pathname-name x)))))
      (compile-and-load file))
    (format t "~%######### User files loaded #########~%")))

619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634

#|
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
|#