;;-*- Mode:LISP; Package:VERIFICATION-INTERNALS; Base:8 -*-
;; (C) Copyright 1983 Lisp Machines Inc.
;; 11/06/83 23:51:33 -George Carrette

;; Copyright LISP Machine, Inc. 1984
;;   See filename "Copyright" for
;; licensing and release information.

;; basic runtime utilities. gjc style/isms misplaced for now in this file.

;;(defflavor embodied-plist ... maybe someday)
;; make it be as fast and flexible as a plist is difficult to do in zetalisp.

(defun get-restl (plist &rest keys)
  (getl plist keys))

(defun get! (object key &optional default-function)
  (let ((cell (get-restl object key)))
    (if cell
	(cadr cell)
	(funcall (or default-function
		     #'(lambda (object key)
			 (ferror 'SYS:WRONG-TYPE-ARGUMENT
				 "No ~S property on ~S" key object)))
		 object key))))

(defun getprop (plist key default)
  (let ((cell (get-restl plist key)))
    (if cell (cadr cell) default)))

(defun getpropd (plist key default)
  (putprop plist (getprop plist key default) key))

(defmacro defproperties (symbol &rest l)
  (do ((v () (cons `(defproperty ,symbol ,(car l) ,(cadr l)) v))
       (l l (cddr l)))
      ((null l)
       `(progn 'compile ,@(nreverse v)))))

(defmacro defproperty (symbol key-pattern value)
  (if (symbolp key-pattern)
      `(defprop ,symbol ,value ,key-pattern)
    `(defun (:property ,symbol ,(car key-pattern)) ,(cdr key-pattern)
       ,value)))


(defsubst plist-name (plist)
  (car plist))

(defun mapkan (f l)
  (apply #'nconc (mapcar f l)))