(defun fget (frame slot facet)
　　　(cdr (assoc facet 
         (cdr (assoc slot 
            (cdr (get frame 'frame)))))))

(putprop 'Henry
　　'(Henry 
        (a-kind-of (value man))
 　　　 (height (value 1.78))
　　　　(weight (value 75))
　　　　(hobies (value jogging skiing))
　　　　(licence (if-needed ask answer))
　　　　(occupation (value teaching research)))
　　　　'frame)

(defun extend (key a-list)
　　　(cond ((assoc key (cdr a-list)))
 　　　　　　(t 
　　　　　　　　(cadr 
                  (rplacd 
                     (last a-list) 
                     (list (list key)))))))

(defun follow-path (path a-list)
　　　(cond ((null path) a-list)
　　　　　　　(t 
　　　　　　　　(follow-path 
                    (cdr path) 
                    (extend (car path) a-list)))))

(defun fget-frame (frame)
　　　(cond ((get frame 'frame))
　　　　　　　(t 
　　　　　　　　(setf (get frame 'frame) 
                      (list frame)))))

(defun fput (frame slot facet value)
　　　(let ((value-list 
               (follow-path 
                   (list slot facet) 
                   (fget-frame frame))))
　　　　(cond ((member value value-list 
                        :test #'equal)
                nil)
　　　　　　　 (t 
　　　　　　　　　(rplacd 
                     (last value-list) 
                     (list value))
                   value))))

(defun fremove (frame slot facet value)
　　　(let ((value-list 
              (follow-path 
                  (list slot facet) 
                  (fget-frame frame))))
　　　　(cond ((member value value-list 
                        :test #'equal)
 　　　　　　　(delete value value-list 
                        :test #'equal)
　　　　　　　　t)
 　　　　　　　(t nil))))

(defun fcheck (frame slot facet value)
　　　(cond ((member value 
                 (fget frame slot facet) 
                     :test #'equal)
                  t)
　　　　　　　(t nil)))

(defun fclamp (frame1 frame2 slot)
　　　(rplacd (fget-frame frame1)
　　　　　　　　(list (follow-path 
                         (list slot) 
                         (fget-frame frame2))))
　　　slot)

(defun fget-v-d (frame slot)
　　　(cond ((fget frame slot 'value))
　　　　　　((fget frame slot 'default))))

(defun fget-v-d-p (frame slot)
　　　(cond ((fget frame slot 'value))
　　　　　　((fget frame slot 'default))
　　　　　　(t 
　　　　　　　(mapcan
　　　　　　　　　#'(lambda (demon) 
                      (fucall demon frame slot))
　　　　　　　　(fget frame slot 'if-needed)))))

(defun ask (frame slot)
　　　(print `(Please supply a value for the
　　　　　　　,slot slot in the
　　　　　　　,frame frame))
　　　　　　　(terpri)
　　　　　　　(let ((response (read)))
　　　　　　　(cond (response (list response))
　　　　　　　　　　(t nil))))

(defun answer (&rest l)
　　　(print '(It has been abswered)))

(setf *print-length* 200)

(setf *print-level* 6)

(defun caluculate-weight (frame slot)
　　(let ((heigh (fget-v-d frame 'height)))
　　　　(cond (height (list (fput frame
　　　　　　　　　　　　　　　　　'weight
　　　　　　　　　　　　　　　　　'value
　　　　　　　　　(* 33 (car height))))))))

(putprop 'man
 　　'(man (a-kind-of (value human))
 　　　　　(hobbies (if-removed report report) 
           (value music reading))
　　　　　(height (if-added caluculate-weight)))
　　　　 'frame)

(putprop 'human
 　　　　'(human (a-kind-of (value being))
 　　　　　　　　(place (value earth)))
 　　　　'frame)

(defun report (&rest l)
　　　(print '(The data has been removed)))

;;;
;;; (fget-classes 'Henry)
;;;      ===>(Henry man human being)
;;;
(defun fget-classes (start)
　　(reverse (fget-classes1 (list start) nil)))

(defun fget-classes1 (queue classes)
　　(cond ((null queue) classes)
　　　　　(t 
　　　　　　(fget-classes1
　　　　　　;;;
　　　　　　(append 
               (fget (car queue) 'a-kind-of 
                                 'value)
 　　　　　　　(cdr queue))
　　　　　　　　;;;
 　　　　　　　(cond ((member (car queue) classes)
　　　　　　　　　　　classes)
 　　　　　　　　　　(t 
 　　　　　　　　　　　(cons (car queue) classes)
                      ))))))

;;;
;;; I-inheritannce
;;;
(defun fget-i (frame slot)
　　(fget-i1 (fget-classes frame) slot))

(defun fget-i1 (frames slot)
　　(cond ((null frames) nil)
　　　　　((fget (car frames) slot 'value))
　　　　　(t 
　　　　　　(fget-i1 (cdr frames) slot))))

;;;
;;; Z-inheritannce
;;;
(defun fget-z (frame slot)
　　(fget-z1 slot (fget-calasses frame)))

(defun fget-z1 (slot classes)
　　(cond ((null classes) nil)
　　　　　((fget-v-d-p (car classes) slot))
　　　　　(t 
　　　　　　(fget-z1 slot (cdr classes)))))

;;;
;;; N-inheritance
;;;
(defun fget-n (frame slot)
   (let ((classes (fget-classes frame)))
  　　(cond ((fget-n1 slot classes 'value))
  　　　　　((fget-n1 slot classes 'default))
  　　　　　((fget-n2 slot classes 'if-needed))
　　　　　　(t nil))))

(defun fget-n1 (slot classes key)
　　　(cond ((null classes) nil)
　　　　　　((fget (car classes) slot key))
　　　　　　(t 
　　　　　　　(fget-n1 slot (cdr classes) key))))

(defun fget-n2 (slot classes key)
　　　(cond ((null classes) nil)
　　　　　　((mapcan #'(lambda (demon) 
                (funcall demon 
                         (car classase) slot))
　　　　　　　　　(fget (car classes) slot key)))
　　　　　　(t 
　　　　　　　(fget-n2 slot (cdr classes) key))))

;;;
;;;
;;;
(defun fput-p (frame slot facet value)
　　(cond ((fput frame slot facet value)
 　　　　　(mapcar #'(lambda (e)
　　　　　　　(mapcar #'(lambda (demon) 
                 (funcall demon frame slot))
　　　　　　　　　　　(fget e slot 'if-added)))
　　　　　　　　　　(fget-classes frame))
 　　　　　value)))

;;;
;;;
;;;
(defun remove-p (frame slot facet value)
　　　(cond ((fremove frame slot facet value)
　　　　　　 (mapcar #'(lambda (e)
　　　　　　　　(mapcar #'(lambda (demon) 
                   (funcall demon frame slot))
　　　　　　　　　　　(fget e slot 'if-removed)))
　　　　　　　　　　　(fget-classes frame))
　　　　　　　value)))

;;;
;;;
;;;
(defun copy-frame (name1 name2)
　　(let ((lst 
            (list 
               name2 
               (second (fget-frame name1)))))
　　　(putprop name2 lst 'frame)))