;;; calc-vec.el --- vector functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
(defun calcFunc-venum (a)
(setq a (calcFunc-vfloor a t))
(or (math-constp a) (math-reject-arg a "*Set must be finite"))
- (let ((p a) next)
- (while (cdr p)
- (setq next (cdr p))
- (if (eq (car-safe (nth 1 p)) 'intv)
- (setcdr p (nconc (cdr (calcFunc-index (math-add
- (math-sub (nth 3 (nth 1 p))
- (nth 2 (nth 1 p)))
- 1)
- (nth 2 (nth 1 p))))
- (cdr (cdr p)))))
- (setq p next))
- a))
+ (let* ((prev a) (this (cdr prev)) this-val next this-last)
+ (while this
+ (setq next (cdr this)
+ this-val (car this))
+ (if (eq (car-safe this-val) 'intv)
+ (progn
+ (setq this (cdr (calcFunc-index (math-add
+ (math-sub (nth 3 this-val)
+ (nth 2 this-val))
+ 1)
+ (nth 2 this-val))))
+ (setq this-last (last this))
+ (setcdr this-last next)
+ (setcdr prev this)
+ (setq prev this-last))
+ (setq prev this))
+ (setq this next)))
+ a)
(defun calcFunc-vpack (a)
(setq a (calcFunc-vfloor a t))
(if w (setq a (math-clip a w)))
(if (math-messy-integerp a) (setq a (math-trunc a)))
(let* ((calc-number-radix 2)
+ (calc-twos-complement-mode nil)
(neg (math-negp a))
(aa (if neg (math-sub -1 a) a))
(str (if (eq aa 0)