home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_FEB87.ZIP / EXPERT.FEB < prev    next >
Encoding:
Text File  |  1987-01-29  |  3.5 KB  |  98 lines
  1.  
  2.  
  3.                          Expert's Toolbox
  4.     "Solving SFRL Problems with a Representation Language Language"
  5.                             Listing 1
  6.  
  7.  
  8. ;; FRLL--A Frame Representation Language Language.  
  9. ;; Copyright 1986 by Jonathan Amsterdam.
  10. (DEFVAR *FRAMES* NIL) ; A list of all the frames ever created (with FPUT or
  11.            ; DEFFRAME). 
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13. ;; Interface functions.
  14. (DEFMACRO DEFFRAME (NAME &REST SLOTS-AND-VALUES)
  15.  `(PROGN
  16.     (PUSHNEW ',NAME *FRAMES*)    ; PUSHNEW adds an item to a list if it
  17.          ; isn't already there.
  18.     ,@(LET ((RESULT NIL))
  19.  (DO ((S-AND-V SLOTS-AND-VALUES (CDDR S-AND-V)))
  20.     ((NULL S-AND-V) (REVERSE RESULT))
  21.    (PUSH `(FPUT ',NAME ',(CAR S-AND-V) ',(CADR S-AND-V))
  22.       RESULT)))))
  23.  
  24. DEFMACRO DEF-RAW-FRAME (NAME &REST SLOTS-AND-VALUES)
  25.  ; Need this to avoid invoking the full FGET mechanism in defining core
  26.  ; frames.
  27.  `(PROGN
  28.     (PUSHNEW ',NAME *FRAMES*)
  29.     ,@(LET ((RESULT NIL))
  30.  (DO ((S-AND-V SLOTS-AND-VALUES (CDDR S-AND-V)))
  31.      ((NULL S-AND-V) (REVERSE RESULT))
  32.    (PUSH `(FPUT-ON-FRAME ',NAME ',(CAR S-AND-V) ,(CADR S-AND-V))
  33.       RESULT)))))
  34. (DEFUN FGET (FRAME SLOT)
  35.  (OR (FGET-ON-FRAME FRAME SLOT)
  36.      (FUNCALL (FGET SLOT 'GET-VALUE) FRAME SLOT)))
  37.  
  38. DEFUN FPUT (FRAME SLOT VALUES)
  39.  (LET ((FUNCTION (FGET SLOT 'PUT-VALUE)))
  40.    (IF FUNCTION
  41. FUNCALL FUNCTION FRAME SLOT VALUES)
  42. (FPUT-ON-FRAME FRAME SLOT VALUES))))
  43. (DEFUN FGET-ON-FRAME (FRAME SLOT)
  44.  (CDR (ASSOC SLOT (GET FRAME 'FRAME))))
  45. (DEFUN FPUT-ON-FRAME (FRAME SLOT VAL)
  46.  (LET ((FRAME-LIST (GET FRAME 'FRAME)))
  47.    (LET ((OLD-SLOT (ASSOC SLOT FRAME-LIST)))
  48.      (IF OLD-SLOT
  49.   (RPLACD OLD-SLOT VAL)
  50.   (PUSHNEW FRAME *FRAMES*)
  51.   (SETF (GET FRAME 'FRAME) (CONS (CONS SLOT VAL) FRAME-LIST))))))
  52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53. ;; Functions which live in the initial network
  54. (DEFUN GET-VALUE-FUNCTION (FRAME SLOT)
  55.  (N-INHERITANCE FRAME SLOT (FGET SLOT 'INHERITS-THROUGH)))è(DEFUN N-INHERITANCE (FRAME SLOT PATH-SLOT)
  56.  ;; Returns the first value found, along PATH-SLOT, using N pattern.
  57.  (OR (FGET-ON-FRAME FRAME SLOT)
  58.      (DOLIST (PARENT (LISTIFY (FGET FRAME PATH-SLOT)))
  59. (LET ((RESULT (N-INHERITANCE PARENT SLOT PATH-SLOT)))
  60.   (IF RESULT (RETURN RESULT))))))
  61. (DEFUN LISTIFY (X)
  62.  (IF (NOT (LISTP X)) (LIST X)))
  63. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  64. ;; Basic core of network.
  65. (DEF-RAW-FRAME FRAME
  66.        AKO 'FRAME)
  67. (DEF-RAW-FRAME SLOT
  68.        AKO 'FRAME
  69.        GET-VALUE 'FGET-ON-FRAME
  70.        PUT-VALUE 'FPUT-ON-FRAME)
  71.  
  72. DEF-RAW-FRAME N-INHERITANCE-SLOT
  73.        SLOT-TYPE 'SLOT
  74.        GET-VALUE 'GET-VALUE-FUNCTION)
  75.   
  76. DEF-RAW-FRAME GET-VALUE
  77.        SLOT-TYPE 'N-INHERITANCE-SLOT
  78.        ;; Set GET-VALUE's GET-VALUE slot explicitly to make it all work.!
  79. ..
  80.        GET-VALUE 'GET-VALUE-FUNCTION
  81.        INHERITS-THROUGH 'SLOT-TYPE)
  82. (DEF-RAW-FRAME PUT-VALUE
  83.        SLOT-TYPE 'N-INHERITANCE-SLOT
  84.        INHERITS-THROUGH 'SLOT-TYPE)
  85. (DEF-RAW-FRAME SLOT-TYPE
  86.        SLOT-TYPE 'SLOT)
  87. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  88. ;; Network used in example
  89. (DEFFRAME CUISINE
  90.   SLOT-TYPE N-INHERITANCE-SLOT
  91.   INHERITS-THROUGH RESTAURANT-TYPE)
  92. (DEFFRAME CHINESE-RESTAURANT
  93.   CUISINE CHINESE)
  94. (DEFFRAME MARY-CHUNGS
  95.   RESTAURANT-TYPE CHINESE-RESTAURANT)
  96.  
  97. ;;; End of file.
  98.