(in-package :maxima)

(print "DONT USE THIS.  USE segment-new.lisp, which is better")

;; implement in Maxima
;;   f(a,b,segment(c,d),e)  --> f(a,b,c,d,e)

;; save the old function definition, if it has not already been
;; saved by previously loading this file.
;; this slows down Maxima by some amount.
;; author: (c)  Richard Fateman 7/24/2014.  You can use it for any purpose. No warranty.

(if (fboundp 'orig-meval1) nil 
  (setf (symbol-function 'orig-meval1)
    (symbol-function 'meval1)))


;; the new definition

(defun nonsegmentp(r)(or (atom r)
			 (not (listp (car r)))
			 (not (eq (caar r) '$segment))))

(defun segment-meval1(h)  ;; new definition. maybe should check for other cases?
  (orig-meval1 (cond ((or (atom h)
			  ($ratp h)
			  (mfexprP h) ;; exclude msetq fro example
			  (every #'nonsegmentp h))
		      h)
		     (t (splice-segment h))) ))

(defun mfexprP (h)(and (listp (setf h(car h)))  ; true for ((msetq) ...)
			 (atom (setf h (car h)))
			 (get h 'mfexpr*)
			 t))


(defun splice-segment(h)
  (let ((res nil))
    (map nil #'(lambda(r) 
		 (if (nonsegmentp r)
		     (push (list r) res)
		   (push (reverse (cdr r)) res))) ;reverse makes fresh copy
	 (cdr h))
    (setf (cdr h) (nreverse (apply #'nconc res)))
    h))

(defun $use_segment(flag)  ;;flip segments on or off.
 ;; that is, command:   use_segment(true) turns it on
  ;; use_segment(false) turns it off
  (cond (flag (setf (symbol-function 'meval1) #'segment-meval1)
	      "Segment is enabled")
	(t (setf (symbol-function 'meval1)  #'orig-meval1)
	   "Segment treatment is disabled")))