home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_DEC86.ZIP / EXPERT.DEC < prev    next >
Encoding:
Text File  |  1986-12-09  |  1.9 KB  |  61 lines
  1.  
  2.                          Code Taken from
  3.                     'Expert's Toolbox' column
  4.                   written by Jonathan Amsterdam
  5.               for the Dec. 1986 issue of AI EXPERT
  6.  
  7.  
  8.                "Retrieval from a Frame Data Base"
  9.  
  10.  
  11. Listing 1
  12.  
  13.  
  14. (DEFUN FMATCH (PATTERN FRAME)
  15.   ;; Returns the frame if it matches the pattern; else, returns NIL.
  16.   (DO ((SLOTS-AND-VALUES PATTERN (CDR SLOTS-AND-VALUES)))
  17.       ((NULL SLOTS-AND-VALUES) FRAME)
  18.     (LET* ((SLOT (CAAR SLOTS-AND-VALUES))
  19.     (PATTERN-VALUE (CADAR SLOTS-AND-VALUES))
  20.     (FRAME-VALUE (FGET FRAME SLOT)))
  21.       (IF (NOT (MEMBER PATTERN-VALUE FRAME-VALUE))
  22.    (RETURN NIL)))))
  23.  
  24.  
  25.  
  26. Listing 2
  27.  
  28.  
  29. (DEFUN FMATCH (PATTERN FRAME)
  30.   ;; Returns the frame if it matches the pattern; else, returns NIL.
  31.   (DO ((SLOTS-AND-VALUES PATTERN (CDR SLOTS-AND-VALUES)))
  32.       ((NULL SLOTS-AND-VALUES) FRAME)
  33.     (LET ((SLOT (CAAR SLOTS-AND-VALUES)))
  34.       (IF (NOT (FMATCH-SLOT
  35.                  (CADAR SLOTS-AND-VALUES)
  36.                  (IF (EQ SLOT 'AKO)
  37.                      (COLLECT-FACET-WITH-INHERITANCE FRAME SLOT 'VALUE)
  38.                      (FGET FRAME SLOT))))
  39.           (RETURN NIL)))))
  40.  
  41. (DEFUN FMATCH-SLOT (PATTERN-VALUE FRAME-VALUE)
  42.   ;; Returns non-NIL iff the pattern-value and the frame-value match.
  43.   (COND
  44.     ((FUNCTIONP PATTERN-VALUE)
  45.      (FUNCALL PATTERN-VALUE FRAME-VALUE))
  46.     ((ATOM PATTERN-VALUE)
  47.      (MEMBER PATTERN-VALUE FRAME-VALUE))
  48.     ((EQ (CAR PATTERN-VALUE) 'NOT)
  49.      (NOT (FMATCH-SLOT (CADR PATTERN-VALUE) FRAME-VALUE)))
  50.     ((EQ (CAR PATTERN-VALUE) 'OR)
  51.      (DOLIST (OR-ITEM (CDR PATTERN-VALUE))
  52.        (IF (FMATCH-SLOT OR-ITEM FRAME-VALUE)
  53.     (RETURN T))))
  54.     ((EQ (CAR PATTERN-VALUE) 'AND)
  55.      (NOT (DOLIST (AND-ITEM (CDR PATTERN-VALUE))
  56.              (IF (NOT (FMATCH-SLOT AND-ITEM FRAME-VALUE))
  57.                  (RETURN T)))))
  58.     (T
  59.       (MEMBER PATTERN-VALUE FRAME-VALUE :TEST #'FMATCH))))
  60.  
  61.