;;; -*- Mode:LISP; Package:USER; Base:10 -*-

;;; $Header: /ct/ctlisp/dlist.l,v 1.3 85/06/21 12:26:57 bill Exp $
;;; $Log:	/ct/ctlisp/dlist.l,v $
;;;Revision 1.3  85/06/21  12:26:57  bill
;;;Changed the record_type definitions to def_record_type.
;;;
;;;Revision 1.2  83/10/12  08:26:13  bill
;;;System works with all files compiled.
;;;
;;;Revision 1.1  83/10/08  00:17:14  bill
;;;Initial revision
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                  ;;;
;;;                             dlist                                ;;;
;;;                                                                  ;;;
;;; William Brew                                        8-11-83      ;;;
;;;                                                                  ;;;
;;; Lisp code for double linked lists.                               ;;;
;;;                                                                  ;;;
;;; This file is part of a proprietary software project.  Source     ;;;
;;; code and documentation describing implementation details are     ;;;
;;; available on a confidential, non-disclosure basis only.  These   ;;;
;;; materials, including this file in particular, are trade secrets  ;;;
;;; of Computer * Thought Corporation.                               ;;;
;;;                                                                  ;;;
;;; (c) Copyright 1982 and 1983,  Computer * Thought Corporation.    ;;;
;;;     All Rights Reserved.                                         ;;;
;;;                                                                  ;;;
;;; Reference materials:                                             ;;;
;;;   Foderaro and Sklower, The FRANZ LISP Manual, September 1981.   ;;;
;;;   Weinreb and Moon, LISP MACHINE MANUAL, Symbolics, July 1981.   ;;;
;;;   Charniak et al., 1980.  Artificial Intelligence Programming.   ;;;
;;;   Miller, 1982.  The C*T Ada Tutor: Guide to the Implementation. ;;;
;;;                                                                  ;;;
;;;   The following code assumes familiarity with these materials.   ;;;
;;;                                                                  ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ensure presence of needed files. 

(comment Assumes ct_load and some suitable file_map are present)

(eval-when (compile load eval) (ct_load 'aip))	   ;AIP macros pkg. 

(eval-when (compile load eval) (ct_load 'compat))  ;Franz/LM compat pkg.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compiler Declarations and Global Variables -- 

#+franz (declare (macros t))
#+franz (setq *flavor-expand-macros* t)

; 
; A cell of a dlist (dlcell) structure consists of two cons cells. The car of the
; first cons cell points to the value; its cdr points to the other cons cell. The
; second cons cell contains the predecessor and successor pointers
; for the dlist. The car is the pred pointer. The cdr is the succ pointer.
;

(def_record_type dlcell nil (val pred . succ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Macro definitions --

; Get the value part of a dlcell
(defmacro dlval (dlcel) `(dlcell%val ,dlcel))

; Get the pred pointer of a dlcell
(defmacro dlpred (dlcel) `(dlcell%pred ,dlcel))

; Get the succ pointer of a dlcell
(defmacro dlsucc (dlcel) `(dlcell%succ ,dlcel))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Flavor definitions --

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Externally Callable Functions/Methods -- 

; --NB may want to some checking for well formed dlcells on input arguments.

; 
; Test whether a thing looks like a dlcell.
; 
; --NB may want to put the tag field in the record.

(defun dlcellp (thing)
    (listp thing)
)

; 
; Get the first dlcell in a dlist structure
; 

(defun dlfirst (dlist)
    (loop for dlcel = dlist then (dlpred dlcel)
	  unless (dlpred dlcel) return dlcel
    )
)
    
; 
; Get the last dlcell in a dlist structure
; 

(defun dllast (dlist)
    (loop for dlcel = dlist then (dlsucc dlcel)
	  unless (dlsucc dlcel) return dlcel
    )
)
    
;
; Insert a new dlcell with the given value at the beginning of the dlist. Makes
; a new dlcell and rplac's it into the dlist. Returns the new first dlcell.
; 

(defun dlinfirst (dlist value)
    (let ((first (dlfirst dlist)))
	(cond (first
	       (%= (dlpred first) (setq first (dlcell value nil first)))
	       first
	      )
	      (t (dlcell value nil nil))
	)
    )
)

;
; Insert a new dlcell with the given value at the end of the dlist. Makes
; a new dlcell and rplac's it into the dlist. Returns the new last dlcell.
; 

(defun dlinlast (dlist value)
    (let ((last (dllast dlist)))
	(cond (last
	       (%= (dlsucc last) (setq last (dlcell value last nil)))
               last
	      )
	      (t (dlcell value nil nil))
	)
    )
)

; 
; Insert a new dlcell with the given value before the given dlcell. Makes
; a new dlcell and rplac's it into the dlist. Returns the new dlcell.
; 

(defun dlinbefore (dlcel value)
    (let ((prev (dlpred dlcel)) new)
	(cond (prev
	       (setq new (dlcell value prev dlcel))
	       (%= (dlpred dlcel) new)
	       (%= (dlsucc prev) new)
	       new
	      )
	      (t (dlinfirst dlcel value))
	)
    )
)

; 
; Insert a new dlcell with the given value after the given cell. Makes
; a new dlcell and rplac's it into the dlist. Returns the new dlcell.
; 

(defun dlinafter (dlcel value)
    (let ((next (dlsucc dlcel)) new)
	(cond (next
	       (setq new (dlcell value dlcel next))
	       (%= (dlpred next) new)
	       (%= (dlsucc dlcel) new)
	       new
	      )
	      (t (dlinlast dlcel value))
	)
    )
)

; 
; Append two dlists together. Take two dlcells and make the first the predicessor
; of the second and the second the successor of the first. Returns the first
; dlcell.
; 

(defun dlappend (dlfirst dlsecond)
    (%= (dlsucc dlfirst) dlsecond)
    (%= (dlpred dlsecond) dlfirst)
    dlfirst
)

;
; Remove a dlcell from its dlist. Rplac's the dlcell out of the dlist.
; Clears the removed dlcell's pointers and returns a copy of the original.
; 

(defun dlrem (dlcel)
    (let* ((prev (dlpred dlcel))
	   (next (dlsucc dlcel))
	   (oldcell (dlcell (dlval dlcel) prev next))
	 )
	(cond (prev (%= (dlsucc prev) next)))
	(cond (next (%= (dlpred next) prev)))
	(%= (dlpred dlcel) nil)
	(%= (dlsucc dlcel) nil)
	oldcell
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal Use Only Functions/Methods -- 

;;; eof
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;