;;;
-;;; $Id: tl-list.el,v 2.0 1994/11/08 11:14:20 morioka Exp $
+;;; $Id: tl-list.el,v 2.5 1994/12/27 01:49:41 morioka Exp $
;;;
(provide 'tl-list)
x))))
+(defun nth-prev (n ls)
+ "Return elements of LS until N - 1 th. [tl-list.el]"
+ (butlast ls (- (length ls) n))
+ )
+
+(defun except-nth (n ls)
+ "Return elements of LS except N th. [tl-list.el]"
+ (append (nth-prev n ls) (nthcdr (+ 1 n) ls))
+ )
+
+(defun last-element (ls)
+ "Return last element. [tl-list.el]"
+ (car (last ls))
+ )
+
+
+;;; @ set
+;;;
+(fset 'is-member 'member)
+
+
;;; @ alist
;;;
;;;
(defun fetch-field (key alist)
- (assoc key alist))
+ (assoc key alist)
+ )
+
+(defun fetch-field-value (key alist)
+ (cdr (assoc key alist))
+ )
(fset 'put-field 'put-alist)
(fset 'delete-field 'del-alist)
+(defun put-fields (tp c)
+ (catch 'tag
+ (let ((r tp) f ret)
+ (while r
+ (setq f (car r))
+ (if (not (if (setq ret (fetch-field (car f) c))
+ (equal (cdr ret)(cdr f))
+ (setq c (cons f c))
+ ))
+ (throw 'tag 'error))
+ (setq r (cdr r))
+ ))
+ c))
+
;;; @ field unifier
;;;