(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "IDENTIFIERS" (USE "LISP" "PT") (NICKNAMES 
"ID") (PREFIX-NAME "ID")))

(il:filecreated "29-Nov-88 19:06:27" il:{qv}<idl>next>identifiers.\;4
 5041   

      il:|changes| il:|to:|  (il:structures identifier identifier-methods id enumeration label) (il:functions enumeration-member-p enumeration-constructor label-member-p label-constructor id-member-p construct-id datum-id make-enumeration enumeration-accessor make-label label-accessor define-identifier make-identifier-constructor)
 (il:variables *enumeration-methods* *label-methods*) (il:vars il:identifierscoms) (il:define-types identifiers)
 (xcl:file-environments "IDENTIFIERS")

      il:|previous| il:|date:| "29-Nov-88 18:01:19" il:{qv}<idl>next>identifiers.\;3)


; Copyright (c) 1988 by Xerox Corporation.  All rights reserved.

(il:prettycomprint il:identifierscoms)

(il:rpaqq il:identifierscoms ((il:define-types identifiers) (il:functions define-identifier) (il:functions make-identifier-constructor) (il:structures identifier identifier-methods id) (il:functions id-member-p construct-id datum-id) (il:coms (il:* il:|;;| "enumeration id") (il:variables *enumeration-methods*) (il:structures enumeration) (il:functions make-enumeration enumeration-member-p enumeration-constructor enumeration-accessor)) (il:coms (il:* il:|;;| "string id") (il:variables *label-methods*) (il:structures label) (il:functions make-label label-member-p label-constructor label-accessor)) (eval-when (load compile) (il:p (export (quote (identifiers define-identifier identifier identifier-p identifier-methods identifier-name identifier-documentation id id-p id-datum id-member-p construct-id datum-id enumeration enumeration-p make-enumeration label label-p make-label)) (find-package "IDENTIFIERS")))) (xcl:file-environments "IDENTIFIERS")))

(xcl:def-define-type identifiers "IDL identifiers(s)")

(xcl:defdefiner define-identifier identifiers (name documentation type &rest keyword-args) (il:bquote (defvar (il:\\\, name) (apply (function (il:\\\, (make-identifier-constructor type))) :name (quote (il:\\\, name)) :documentation (il:\\\, documentation) (il:\\\,@ keyword-args)))))

(defun make-identifier-constructor (type) (intern (concatenate (quote string) "MAKE-" (string type)) (find-package "IDENTIFIERS")))

(defstruct (identifier (:constructor nil) (:copier nil)) methods documentation cases)

(defstruct identifier-methods member-p constructor accessor)

(defstruct id datum)

(defun id-member-p (id identifier) (funcall (identifier-methods-member-p identifier) id identifier))

(defun construct-id (tag identifier) (funcall (identifier-methods-constructor) tag identifier))

(defun datum-id (id identifier) (funcall (identifier-methods-accessor) id identifier))



(il:* il:|;;| "enumeration id")



(defparameter *enumeration-methods* (make-identifier-methods :member-p (quote enumeration-member-p) :constructor (quote enumeration-constructor) :accessor (quote enumeration-accessor)))

(defstruct (enumeration (:constructor %make-enumeration) (:include identifier (methods *enumeration-methods*))) instances)

(defun make-enumeration (&key name documentation) (%make-enumeration :name name :documentation documentation))

(defun enumeration-member-p (object identifier) (and (memq object (enumeration-instances identifier)) t))

(defun enumeration-constructor (tag identifier) (let ((instance (make-id :datum tag))) (push instance (enumeration-instances identifier)) instance))

(defun enumeration-accessor (id identifier) (declare (ignore identifier)) (id-datum id))



(il:* il:|;;| "string id")



(defparameter *label-methods* (make-identifier-methods :member-p (quote label-member-p) :constructor (quote label-constructor) :accessor (quote label-accessor)))

(defstruct (label (:constructor %make-label) (:include identifier (methods *label-methods*))) prefix instances)

(defun make-label (&key name documentation prefix) (%make-label :name name :documentation documentation :prefix prefix))

(defun label-member-p (object identifier) (and (memq object (label-instances identifier)) t))

(defun label-constructor (tag identifier) (let* ((prefix (label-prefix identifier)) (instance (make-id :datum (if prefix (concatenate (quote string) prefix (princ-to-string tag)) tag)))) (push instance (label-instances identifier)) instance))

(defun label-accessor (id identifier) (declare (ignore identifier)) (id-datum id))
(eval-when (load compile)

(export (quote (identifiers define-identifier identifier identifier-p identifier-methods identifier-name identifier-documentation id id-p id-datum id-member-p construct-id datum-id enumeration enumeration-p make-enumeration label label-p make-label)) (find-package "IDENTIFIERS"))
)

(xcl:define-file-environment "IDENTIFIERS" :readtable "XCL" :package (xcl:defpackage "IDENTIFIERS" (:use "LISP" "PT") (:nicknames "ID") (:prefix-name "ID")) :compiler :compile-file)
(il:putprops il:identifiers il:copyright ("Xerox Corporation" 1988))
(il:declare\: il:dontcopy
  (il:filemap (nil)))
il:stop