code for syntactic extension of OL to slot-values notation

Tom Gruber <Gruber@sumex-aim.stanford.edu>
Full-Name: Tom Gruber
Message-id: <2871844185-2358678@KSL-Mac-69>
Date: Wed, 2 Jan 91  14:29:45 PST
From: Tom Gruber <Gruber@sumex-aim.stanford.edu>
To: ontolingua@sumex-aim.stanford.edu
Subject: code for syntactic extension of OL to slot-values notation
I wrote a transform for define-class that allows one to use the
familiar slot-values notation.  That is, instead of saying
  (define-class person (?p)
     :implies ((no-of-chromosome-pairs ?p 23))
     :second-order ((superclass person animal)
                    (superclass person taxpayer)))
one can write
  (define-class person (?p)
     :slot-values ((superclass animal taxpayer))
     :instance-slot-values ((no-of-chromosome-pairs 23)))

The code below implements the layer on top of the
ontolingua:define-class macro.  If it makes sense, it can be easily
added to the language.  			tom


(defmacro define-class (class-name arg-list doc-string &key
                            string-name
                            slot-values
                            instance-slot-values
                            default-instance-slot-values
                            definition
                            primitive-definition 
                            equivalent 
                            sufficient 
                            implies 
                            second-order 
                            default-implies)
 "extension to original ontolingua define-class that allows the following keyword args:
:SLOT-VALUES ((slot-name slot-value1 slot-value2 ...) (slot-name2 ...)
:INSTANCE-SLOT-VALUES ((slot-name slot-value1 slot-value2 ...) ...)
:DEFAULT-INSTANCE-SLOT-VALUES ((slot-name slot-value1 slot-value2 ...) ...)

This extension adds syntactic calories but is nutrition-free!
It allows one to state things in a frame-like way instead of the PC way.
:SLOT-VALUES expressions get turned into :SECOND-ORDER statements.
  (Remember, these are slots on classes.)
:INSTANCE-SLOT-VALUES expressions get turned into :IMPLIES statements.
  (This is like Cyc's "inherited slots" on "allInstanceOf".)
:DEFAULT-INSTANCE-SLOT-VALUES expressions turn into :DEFAULT-IMPLIES statements.
  (Same as :INSTANCE-SLOT-VALUES, except they are inherited as defaults.)
"
  (let* ((instance-variable (first arg-list))
         ;; transform SLOT-VALUES into SECOND-ORDER statements
         (extra-SECOND-ORDER-clauses
           (loop for (slot . values) in slot-values
                 nconc (loop for value in values
                              collect `(,slot ,class-name ,value))))
         ;; transform INSTANCE-SLOT-VALUES into IMPLIES statements
         (extra-IMPLIES-clauses
           (loop for (slot . values) in instance-slot-values
                 nconc (loop for value in values
                             collect `(,slot ,instance-variable ,value))))
         ;; transform DEFAULT-INSTANCE-SLOT-VALUES into DEFAULT-IMPLIES statements
         (extra-DEFAULT-IMPLIES-clauses
           (loop for (slot . values) in default-instance-slot-values
                 nconc (loop for value in values
                             collect `(,slot ,instance-variable ,value))))
         )
    (flet ((splice-in (keyword value-expression)
              (if value-expression
                  (list `(,keyword ,value-expression)))))
    `(OL:define-class ,class-name ,arg-list
       ,doc-string
       ,@(splice-in :string-name string-name)
       ,@(splice-in :definition definition)
       ,@(splice-in :primitive-definition primitive-definition)
       ,@(splice-in :equivalent equivalent)
       ,@(splice-in :sufficient sufficient)
       ,@(splice-in :implies (nconc extra-IMPLIES-clauses implies))
       ,@(splice-in :default-implies (nconc extra-DEFAULT-IMPLIES-clauses default-implies))
       ,@(splice-in :second-order (nconc extra-SECOND-ORDER-clauses second-order))
       ))))