Saving Objects with CLOS

[Thad.Humphries@p0.f70.n109.z1.FidoNet.Org (Thad Humphries)]

A while back someone asked about CLOS techniques for saving objects.  Sorry to burden the whole net with this but I've misplaced his address.  Anyway, here is an approach I used recently for a graduate project on expert systems.

I tried using SAVE-OBJECT.LISP from contrib/MCL2 but it was very large for this project (which ended up barely over 5000 lines) and I never got it running properly anyway.  However, I found my approach had several benefits:
1) it was very simple
2) it worked for any object I created
3) objects were easily modifiable without losing data
4) objects were saved in text form for easy inspecting or editing of errors

First, I kept instances of each object in a list.  The project concerned diets and menu planning so I had lists for diet profiles, USDA meal requirements, ingredients, recipes, etc.  The user selected a file thru the Mac's SF Dialog.  First the list name was written.  The intances then followed on separate lines.  My function INSTANCE-TO-LIST used CLOS to put a instance into a list that could be written with PRIN1-TO-STRING.

To recover all instances, open the file with an SF Dialog.  Loop over all lines using READ-FROM-STRING to get the data into a list and VALUES-LIST to extract the items from the list.  Now use the MULTIPLE-VALUE-CALL to give this result to your function containing the correct MAKE-INSTACE command.  Use the list name to know when to jump to a new loop.

Hope this helps...

;;;; Partial listings follow ;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Write slot values of an instance to a list.  Used for saving slots.
(defmethod instance-to-list ((instance standard-object))
  (let ((class (class-of instance)) (line nil))
        (dolist (dslot (class-slots class) (reverse line))
          (setq line (cons (slot-value instance (slot-definition-name dslot))
                           line)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Save dataset to a file.  If file specified exists, overwrite; else, create.
(defun save-dataset-to-file (&optional file)
  (if (null file)
    (progn
      (setq file (choose-new-file-dialog
                  :prompt "New Data File:"
                  :button-string "Create"))
      (setq *working-file* file)))
  (with-open-file (out-stream file
                              :direction :output
                              :if-exists :supersede		; SFDialog will prompt
                              :if-does-not-exist :create)
    ;;  A long line for long objects else you get a word wrap
    (let ((line nil) (an-object nil) (*print-right-margin* 10240000))
      ;; Save profiles.
      (write-line "profiles" out-stream)
      (dolist (new-profile (ordered-list *human-profiles*))
        (setq an-object (locate-symbol new-profile *human-profiles*))
        (setq line (instance-to-list an-object))
        (write-line (prin1-to-string line) out-stream))
      ;; Save menu-patterns.
      (write-line "menu-patterns" out-stream)
      (dolist (new-menu-pattern (ordered-list *menu-patterns*))
        (setq an-object (locate-symbol new-menu-pattern *menu-patterns*))
        (setq line (instance-to-list an-object))
        (write-line (prin1-to-string line) out-stream))
..

      ))
  (set-mac-file-type file "1309")
  (setq *dirty* nil))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ask user for a Menu Planner file and load it.
(defun restore-dataset-from-file ()
  (purge-dataset)
  (catch 'end-file
    (setq *working-file* (choose-file-dialog
                          :mac-file-type "1309"))
    (with-open-file (in-stream *working-file*
                               :direction :input)
      (let ((line nil) (eof "^Z"))
        ;; Loop over profiles.
        (catch 'end-profiles
          (loop
            (setq line (read-line in-stream nil eof))
            (cond ((equal line eof) (throw 'end-file nil))
                  ((equal line "menu-patterns") (throw 'end-profiles nil))
                  ((equal line "profiles") nil)
                  (t (multiple-value-call 'create-human-profile
                                          (values-list (read-from-string line)))))))
        ;; Loop over menu-patterns.
        (catch 'end-menu-patterns
          (loop
            (setq line (read-line in-stream nil eof))
            (cond ((equal line eof) (throw 'end-file nil))
                  ((equal line "ingredients") (throw 'end-menu-patterns nil))
                  ((equal line "menu-patterns") nil)
                  (t (multiple-value-call 'create-menu-pattern
                                          (values-list (read-from-string line)))))))
..
      ))))