;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: COMMON-LISP-USER; Base: 10. -*-

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                                                          ;
;  COPYRIGHT (C) UNIVERSITY OF SOUTHERN CALIFORNIA, 1988, 1995             ; 
;  University of Southern California, Information Sciences Institute       ;
;  4676 Admiralty Way                                                      ;
;  Marina Del Rey, California 90292                                        ;
;                                                                          ;
;  This software was developed under the terms and conditions of Contract  ;
;  No. MDA903 81 C 0335 between the Defense Advanced Research Projects     ;
;  Agency and the University of Southern California, Information Sciences  ; 
;  Institute.  Use and distribution of this software is further subject    ;
;  to the provisions of that contract and any other agreements developed   ;
;  between the user of the software and the University of Southern         ;
;  California, Information Sciences Institute.  It is supplied "AS IS",    ;
;  without any warranties of any kind.  It is furnished only on the basis  ;
;  that any party who receives it indemnifies and holds harmless the       ;
;  parties who furnish and originate it against any claims, demands, or    ;
;  liabilities connected with using it, furnishing it to others or         ;
;  providing it to a third party.  THIS NOTICE MUST NOT BE REMOVED FROM    ;
;  THE SOFTWARE, AND IN THE EVENT THAT THE SOFTWARE IS DIVIDED, IT SHOULD  ;
;  BE ATTACHED TO EVERY PART.                                              ;
;                                                                          ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

;;; COMPILE-LOOM.LISP ()

;;; Compile and load all files necessary to install the LOOM system.


(unless (find-package "COMMON-LISP")
  (let ((lisp-package (find-package "LISP")))
    (rename-package lisp-package
		    "LISP"
		    (append (package-nicknames lisp-package)
			    '("COMMON-LISP" "CL")))))
(unless (find-package "COMMON-LISP-USER")
  (let ((user-package (find-package "USER")))
    (rename-package user-package
		    "USER"
		    (append (package-nicknames user-package)
			    '("COMMON-LISP-USER" "CL-USER")))))

(in-package "COMMON-LISP-USER")

(push :use-units *features*) 

;; Make a pathname pointing to the top of the Loom directories hierarchy:
;;
;;***************************************************************************
;;*                                                                         *
;;*  IMPORTANT NOTE:  NON-ISI USERS MUST CHANGE THE FOLLOWING DEFVAR!       *
;;*  MOVED TO 0-loom-where-am-I.lisp !!                                                                        *
;;***************************************************************************
;;

(let ((where-am-i 
       (make-pathname 
	:name "0-loom-where-am-i"
	:type  "lisp"
	:device (pathname-device cl-user::*load-truename*) 
	:host (pathname-host cl-user::*load-truename*) 
	:directory  (pathname-directory	  cl-user::*load-truename*))))
(load where-am-i))

;;; (defvar *loom-pathname-default* (pathname "/Users/bateman/software/KPML-LW-PE/loom4.0/"))

(defmacro truncate-name (name)
 ;; Support for brain-damaged DOS filenames
 #-:aclpc name
 #+:aclpc (let ((var (gensym)))
	    `(let ((,var ,name))
	       (if (> (length ,var) 8) (subseq ,var 0 8) ,var)))
 )

#-:aclpc(defvar *lisp-extension* "lisp")
#+:aclpc(defvar *lisp-extension* "lsp")

;;;; WITH-REDEFINITION-WARNINGS-SUPPRESSED

#+:MCL
(defmacro with-redefinition-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress redefinition warnings
  `(let ((CCL::*warn-if-redefine* nil))
     ,@forms ))

#+:EXCL
(defmacro with-redefinition-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress redefinition warnings
  `(let ((EXCL::*redefinition-warnings* nil))
     ,@forms ))

#+:ACLPC
(defmacro with-redefinition-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress redefinition warnings
  `(let ((top::*warn-on-redefinition* nil))
     ,@forms ))

#+:LUCID
(defmacro with-redefinition-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress redefinition warnings
  `(let ((USER::*redefinition-action* nil))
     ,@forms ))

#+:TI
(defmacro with-redefinition-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress redefinition warnings
  `(let ((TICL::inhibit-fdefine-warnings t))
     ,@forms ))

#-(or :MCL :EXCL :ACLPC :LUCID :TI)
(defmacro with-redefinition-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress redefinition warnings
  ;; Default: Do nothing:
  `(progn ,@forms ))

;;;; WITH-UNDEFINED-FUNCTION-WARNINGS-SUPPRESSED

#+:lispm
(defmacro with-undefined-function-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress undefined function warnings
  `(compiler:compiler-warnings-context-bind ,@forms))

#+:lucid
(defmacro with-undefined-function-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress undefined function warnings
  `(lucid-common-lisp:with-deferred-warnings ,@forms))

#+(or (and :CLTL2 (not :lucid) 
	   (not :allegro-v4.2) (not :allegro-v4.3)
	   (not :allegro-v5.0) (not :allegro-v5.0.1))
      (and :CMU :new-compiler))
(defmacro with-undefined-function-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress undefined function warnings
  `(with-compilation-unit () ,@forms))

#+(or :allegro-v4.2 :allegro-v4.3 :allegro-v5.0 :allegro-v5.0.1)
(defmacro with-undefined-function-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress undefined function warnings
  `(handler-bind ((excl:compiler-undefined-functions-called-warning
		   #'(lambda (c) (declare (ignore c)) (muffle-warning))))
     ,@forms))

#-(or :lispm :lucid :CLTL2 (and :CMU :new-compiler)
      :allegro-v4.2 :allegro-v4.3 :allegro-v5.0 :allegro-v5.0.1)
(defmacro with-undefined-function-warnings-suppressed (&body forms)
  ;; Wrap form with code to suppress undefined function warnings
  ;; Default: Do nothing:
  `(progn ,@forms ))



;; load the file "pathnames.lisp":
    ;; THE ":CASE" OPTION FOR "MAKE-PATHNAME" ISN'T IMPLEMENTED IN TI CL:
(let ((path (make-pathname :name #-(and :TI :ISI) (truncate-name "pathnames")
			         #+(and :TI :ISI) "PATHNAMES"
			   :type #-(and :TI :ISI) *lisp-extension*
			         #+(and :TI :ISI) "LISP"
			   :defaults *loom-pathname-default*)))
  (load path))

;;; Now compile and load LOOM sources from three different directories:
;;; Setup implementation-specific variables and forms to:
;;;    1)  Inhibit function redefinition warnings.
;;;    2)  Do all compilation before warning about undefined functions.
(let (#+(or :Allegro-V4.1 :Allegro-V4.2 :allegro-v4.3
	    :allegro-v5.0 :allegro-v5.0.1)
        (comp:*cltl1-compile-file-toplevel-compatibility-p* nil)
      #+(and :EXCL :UNIX :ISI)
      (umaskValue
       (read-line (excl:run-shell-command "umask" :output :stream :wait nil)))
      #+(or :lispworks :Allegro-V4.1 :Allegro-V4.2 :allegro-v4.3 :allegro-v5.0)
      (*compile-print* nil))
  #+(and :EXCL :UNIX :ISI) (excl:run-shell-command "umask 002" :wait t)

  (with-redefinition-warnings-suppressed
      (with-undefined-function-warnings-suppressed
	  (make:operate-on-system 'loom :compile :force t)
          ))

  #+(and :EXCL :UNIX :ISI)
  (excl:run-shell-command (format nil "umask ~A" umaskValue) :wait t)
  )

(format t "~%Please call (LOOM:use-loom <pkg>) to import LOOM symbols into <pkg> and~%~
           create a context named <pkg>-THEORY, e.g., (LOOM:use-loom \"FOO\").~%~%")


