(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