(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL")
(IL:FILECREATED "16-May-90 15:30:14" IL:|{DSK}<usr>local>lde>lispcore>sources>DEFFER-RUNTIME.;2| 4543   

      IL:|changes| IL:|to:|  (IL:VARS IL:DEFFER-RUNTIMECOMS)

      IL:|previous| IL:|date:| " 6-Jul-88 20:55:09" 
IL:|{DSK}<usr>local>lde>lispcore>sources>DEFFER-RUNTIME.;1|)


; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.

(IL:PRETTYCOMPRINT IL:DEFFER-RUNTIMECOMS)

(IL:RPAQQ IL:DEFFER-RUNTIMECOMS
          ((IL:INITVARS (IL:FILEPKGFLG NIL))
           
           (IL:* IL:|;;| "The definer data structures and manipulation functions")

           
           (IL:* IL:|;;| "Must be shared with IL for compatibility with old definers")

           (IL:VARIABLES *DEFINITION-HASH-TABLE*)
           
           (IL:* IL:|;;| "Prototype definition facility")

           (IL:VARIABLES *DEFINITION-PROTOTYPES*)
           (IL:FUNCTIONS ADD-PROTOTYPE-FN PROTOTYPE-DEFN-TYPES PROTOTYPE-DEFINERS-FOR-TYPE 
                  MAKE-PROTOTYPE %MAKE-FUNCTION-PROTOTYPE)
           (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
                  IL:DEFFER-RUNTIME)
           (IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS (IL:ADDVARS
                                                                                         (IL:NLAMA)
                                                                                         (IL:NLAML)
                                                                                         (IL:LAMA)))))

(IL:RPAQ? IL:FILEPKGFLG NIL)



(IL:* IL:|;;| "The definer data structures and manipulation functions")




(IL:* IL:|;;| "Must be shared with IL for compatibility with old definers")


(DEFGLOBALVAR *DEFINITION-HASH-TABLE* (MAKE-HASH-TABLE :TEST #'EQ :SIZE 20))



(IL:* IL:|;;| "Prototype definition facility")


(DEFGLOBALVAR *DEFINITION-PROTOTYPES* NIL

   (IL:* IL:|;;| "An association list mapping file-manager types to association lists from definer-names to prototype-functions")

   )

(DEFUN ADD-PROTOTYPE-FN (TYPE DEFINER PROTOTYPE-FN)
   (LET ((TYPE-ALIST (ASSOC TYPE *DEFINITION-PROTOTYPES* :TEST #'EQ)))
        (IF (NULL TYPE-ALIST)

            (IL:* IL:|;;| "No entry for this type -- add one")

            (SETQ *DEFINITION-PROTOTYPES* (ACONS TYPE (LIST (CONS DEFINER PROTOTYPE-FN))
                                                 *DEFINITION-PROTOTYPES*))
            (LET ((DEFINER-ALIST (ASSOC DEFINER (CDR TYPE-ALIST)
                                        :TEST
                                        #'EQ)))

                 (IL:* IL:|;;| "If this definer didn't already have a PROTOTYPE-FN, add one.  If it already had one, change it to the new one.")

                 (IF (NULL DEFINER-ALIST)
                     (SETF (CDR TYPE-ALIST)
                           (ACONS DEFINER PROTOTYPE-FN (CDR TYPE-ALIST)))
                     (SETF (CDR DEFINER-ALIST)
                           PROTOTYPE-FN))))))

(DEFUN PROTOTYPE-DEFN-TYPES ()

(IL:* IL:|;;;| 
"Return a list of the file-manager types for which some definer can provide a prototype definition.")

   (MAPCAN #'(LAMBDA (X)
                    (IF (CDR X)
                        (LIST (CAR X))))
          *DEFINITION-PROTOTYPES*))

(DEFUN PROTOTYPE-DEFINERS-FOR-TYPE (TYPE)

(IL:* IL:|;;;| "Return a list of the definers that claim to be able to provide a prototype definition of the given type.")

   (MAPCAR #'CAR (CDR (ASSOC TYPE *DEFINITION-PROTOTYPES* :TEST #'EQ))))

(DEFUN MAKE-PROTOTYPE (NAME TYPE DEFINER)
   (LET ((PROTOTYPE-FN (CDR (ASSOC DEFINER (CDR (ASSOC TYPE *DEFINITION-PROTOTYPES* :TEST
                                                       #'EQ))
                                   :TEST
                                   #'EQ))))
        (AND PROTOTYPE-FN (FUNCALL PROTOTYPE-FN NAME))))

(DEFUN %MAKE-FUNCTION-PROTOTYPE ()

   (IL:* IL:|;;| "dummy definition -- redefined by SEdit")

   (LIST (LIST "Arg List")
         "Body"))

(IL:PUTPROPS IL:DEFFER-RUNTIME IL:FILETYPE COMPILE-FILE)

(IL:PUTPROPS IL:DEFFER-RUNTIME IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "XCL"))
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS 

(IL:ADDTOVAR IL:NLAMA )

(IL:ADDTOVAR IL:NLAML )

(IL:ADDTOVAR IL:LAMA )
)
(IL:PUTPROPS IL:DEFFER-RUNTIME IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990))
(IL:DECLARE\: IL:DONTCOPY
  (IL:FILEMAP (NIL)))
IL:STOP
