[Openmcl-devel] Re: Trying to get LISA to run

[nrms]

Am 29.03.2005 um 15:51 schrieb Gary Byers:

>
>
> On Tue, 29 Mar 2005, nrms wrote:
>
>> Okay, no wonder nobody replied, since what I wrote was nonsense.
>
> Sorry. Replying was on my to-do list.  Honest.
>

I was just unsatisfied with my unqualified assumptions. Thanks for 
helping again, now seems to work, although I might have overlooked some 
bad side effects.


>
> (defun lisa-debugger ()
>    (translate-logical-pathname "lisa:debugger;lisa-debugger.lisp"))
>
> #+openmcl
> (pushnew (pathname-directory (lisa-debugger))
>          ccl:*module-search-path*
>          :test #'equal)
>
> should cause (
>
> ? (REQUIRE "LISA-DEBUGGER")
>
> to find and load "lisa-debugger.lisp".
That almost did it, only the value returned pathname-directory seems to 
be in the wrong format for require. That is why I just coded 
lisa-debugger-dir function.


>> The major problem seems to be that in a file called epilogue.lisp I 
>> got
>> the following code
>>
>>   (set-dispatch-macro-character
>>       #\# #\? #'(lambda (strm subchar arg)
>>
>> which is the evildoer. Is the problem here that character "?" is the
>> prompt in openmcl?  Is there an intelligent way to solve this 
>> conflict?
>
>


>
> 3) Use separate readtables (with separate definitions of #?).
>
> (3) is probably the cleanest solution, but may be somewhat awkward for
> users.
>
Thanks for the hint with the readtable, I tried to implement something, 
but the whole thing looks like an evil ugly hack which at least on the 
first glance seem to work. I am not sure whether it was good idea to 
establish a different readtable for installing this and removing it 
afterwards. It seems the code is bound to the table I used and I can 
call (require "cocoa") afterwards. You said it may be awkward for the 
the user, in what way?

Cheers and thanks again,

Nils


(in-package :cl-user)

(defvar *lisa-readtable*
            (copy-readtable *readtable*))

(defun new-readtable (new)
   (if (not (readtablep new))
       (error "new-readtable: Bad readtable: ~A" new))
   (setf *old-readtable* *readtable*)
   (setf *readtable* new))

(defun old-readtable ()
   (setf *readtable* *old-readtable*)
   (setf *old-readtable* nil))

(defvar *lisa-root-pathname*
     (make-pathname :directory
                    (pathname-directory *load-truename*)
                    :host (pathname-host *load-truename*)
                    :device (pathname-device *load-truename*)))

(defun make-lisa-path (relative-path)
   (concatenate 'string (namestring *lisa-root-pathname*)
                relative-path))

(setf (logical-pathname-translations "lisa")
   `(("src;**;" ,(make-lisa-path "src/**/"))
     ("lib;**;*.*" ,(make-lisa-path "lib/**/"))
     ("config;*.*" ,(make-lisa-path "config/"))
     ("debugger;*.*" ,(make-lisa-path "src/debugger/"))
     ("contrib;**;" ,(make-lisa-path "contrib/**/"))))

(defun lisa-debugger ()
   (translate-logical-pathname "lisa:debugger;lisa-debugger.lisp"))

#+openmcl
(defun lisa-debugger-dir ()
   (translate-logical-pathname "lisa:debugger;"))


#+openmcl
(new-readtable *lisa-readtable*)

#+openmcl
(pushnew (lisa-debugger-dir)
	 ccl:*module-search-path*
          :test #'equal)

(eval-when (:load-toplevel :execute)
   (flet ((find-or-load-system (system path)
            (let ((path (merge-pathnames path *load-truename*)))
              (unless (asdf:find-system system nil)
                (load path)))))
     (find-or-load-system :lisa.packages
                          (make-pathname
                           :directory '(:relative "src" "packages")
                           :name "packages" :type "asd" :case :local))
     (find-or-load-system :lisa.implementations
                          (make-pathname
                           :directory '(:relative "src" 
"implementations")
                           :name "implementations" :type "asd" :case 
:local))
     (find-or-load-system :lisa.utils
                          (make-pathname
                           :directory '(:relative "src" "utils")
                           :name "utils" :type "asd" :case :local))
     (find-or-load-system :lisa.reflect
                          (make-pathname
                           :directory '(:relative "src" "reflect")
                           :name "reflect" :type "asd" :case :local))
     (find-or-load-system :lisa.core
                          (make-pathname
                           :directory '(:relative "src" "2.0-core")
                           :name "core" :type "asd" :case :local))
     (find-or-load-system :lisa.rete
                          (make-pathname
                           :directory '(:relative "src" "rete" 
"reference")
                           :name "rete" :type "asd" :case :local))
     (find-or-load-system :lisa.config
                          (make-pathname
                           :directory '(:relative "src" "config")
                           :name "config" :type "asd" :case :local))
     (asdf:operate 'asdf:compile-op :lisa :force t)))


#+openmcl
(compile-file (lisa-debugger))


#+openmcl
(require "lisa-debugger")

(defun compile-lisa (&key (force nil))
   (asdf:operate 'asdf:compile-op :lisa :force force))

(defun load-lisa ()
   (asdf:operate 'asdf:load-op :lisa))

#+openmcl
(old-readtable)