;;; -*- Mode: LISP; Base: 10; Vsp: 1; Syntax: Rhet; Package: RPRS -*-
;;;;;
;;;;; Copyright (C) 1989 by the University of Rochester. All rights reserved.
;;;;; See your Rhet license agreement and file RPRS:rprs;copyright.text for more details.
;;;;;
(in-package rprs)

;;;;; Not completely ported; the example is uninteresting as it duplicates cook. (Henry's constraints are already calculated via the
;;;;; constructor functions)

;;; Portions Copyright 1987 by Henry A. Kautz
;;; This software may be freely distributed in original or modified
;;; form, under the condition that this copyright notice is included.
;;; No warranty as to the correctness or usefulness of this software
;;; is given or implied.
;;;
;;; The author may be contacted at the following addresses:
;;; :uucp:	allegra!kautz		
;;; :arpa: or :csnet:	kautz@allegra.att.com
;;; :old style csnet: 	kautz%allegra@btl.csnet
;;; :mail:	AT&T Bell Laboratories	
;;;		Room 3C-402A
;;;		600 Mountain Ave.	
;;;		Murray Hill, N.J. 07974	
;;; This software was not produced while the author was employee of 
;;; AT&T Bell Laboratories, and that organization has no legal 
;;; claim or responsibility for this software.
;;;


;;;; file system test
;;;;    demonstrates equality constraints and 
;;;;    multiple events

(DEFINE-SUBTYPE 'T-RENAME 'T-END :ROLES '((OLD T-U) (NEW T-U) (TIME T-TIME)))

(DEFINE-SUBTYPE 'T-RENAME-BY-MOVE 'T-RENAME
  :RELATIONS '((:STEPS [C-MOVE [F-OLD ?SELF] [F-NEW ?SELF] [F-TIME ?SELF]])))

(DEFINE-SUBTYPE 'T-rename-by-copy 'T-RENAME
  :RELATIONS '((:steps [C-copy [copy-orig-step ?SELF]] [C-delete [delete-orig-step ?SELF]]))
  :CONSTRAINTS '([EQ? [F-old ?SELF] [F-OLD [copy-orig-step ?SELF]]]
		 [EQ? [F-new ?SELF] [F-NEW [copy-orig-step ?SELF]]]
		 [EQ? [F-old ?SELF] [F-FILE [delete-orig-step ?SELF]]]
		 [TIME-CONTAINS [F-TIME ?SELF] [F-TIME [copy-orig-step ?SELF]]]
		 [TIME-contains [F-TIME ?SELF] [F-TIME [delete-orig-step ?SELF]]]
		 [TIME-RELN [F-TIME [copy-orig-step ?SELF]] (:B :M) [F-TIME [delete-orig-step ?SELF]]]))

(DEFINE-SUBTYPE 'T-MODIFY 'T-END
  :ROLES '((FILE T-U) (TIME T-TIME) (T1 T-TIME) (T2 T-TIME) (T3 T-TIME))
  :RELATIONS '((:steps [C-copy [backup-step ?SELF]] [C-edit [edit-step ?SELF]] [C-delete [delete-backup-step ?SELF]]))
  :CONSTRAINTS '([EQ? [F-OLD [BACKUP-STEP ?SELF]] [F-FILE ?SELF]]
		 [EQ? [F-FILE [EDIT-STEP ?SELF]] [F-FILE ?SELF]]
		 [EQ? [F-FILE [DELETE-BACKUP-STEP ?SELF]] [F-NEW [BACKUP-STEP ?SELF]]]
		 [TIME-EQUALS [F-T1 ?SELF] [F-TIME [BACKUP-STEP ?SELF]]]
		 [TIME-EQUALS [F-T2 ?SELF] [F-TIME [EDIT-STEP ?SELF]]]
		 [TIME-EQUALS [F-T3 ?SELF] [F-TIME [DELETE-BACKUP-STEP ?SELF]]]
		 [TIME-CONTAINS [F-TIME ?SELF] [F-T1 ?SELF]]
		 [TIME-CONTAINS [F-TIME ?SELF] [F-T2 ?SELF]]
		 [TIME-CONTAINS [F-TIME ?SELF] [F-T3 ?SELF]]
		 [TIME-RELN [F-T1 ?SELF] (:B :M) [F-T2 ?SELF]]
		 [TIME-RELN [F-T2 ?SELF] (:B :M) [F-T3 ?SELF]]))

(DEFINE-FUNCTIONAL-SUBTYPE 'T-COPY 'T-ANY :ROLES '((OLD T-U) (NEW T-U) (TIME T-TIME)))

(DEFINE-FUNCTIONAL-SUBTYPE 'T-DELETE 'T-ANY :ROLES '((FILE T-U) (TIME T-TIME)))

(DEFINE-FUNCTIONAL-SUBTYPE 'T-MOVE 'T-ANY :ROLES '((OLD T-U) (NEW T-U) (TIME T-TIME)))

(DEFINE-FUNCTIONAL-SUBTYPE 'T-EDIT 'T-ANY :ROLES '((FILE T-U) (TIME T-TIME)))
