;; This file:
;;   http://anggtwu.net/MAXIMA/2025-dim-save.lisp.html
;;   http://anggtwu.net/MAXIMA/2025-dim-save.lisp
;;          (find-angg "MAXIMA/2025-dim-save.lisp")
;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;;
;; (defun e () (interactive) (find-angg "MAXIMA/2025-dim-save.lisp"))
;; (find-maximamsg "59245215 202510 11" "Edrx: The results of \"dim-*\" functions look reversed - in a weird way")
;; (find-maximamsg "59245615 202510 12" "Edrx: Reversing the result of dim-* functions in the right way: some progress")
;;
;; Superseded by: (find-angg "MAXIMA/2025-testdispla.lisp")
;;
;; «.my-reverse»		(to "my-reverse")
;; «.contract-chars»		(to "contract-chars")
;; «.contract-chars-tests»	(to "contract-chars-tests")
;; «.testdispla-redef»		(to "testdispla-redef")
;; «.testdispla-redef-tests»	(to "testdispla-redef-tests")

(defvar dim-saved)

(setq dim-saved nil)

(defun dim-save (&rest plist)
  (setq dim-saved `(,@dim-saved ,(copy-tree plist)))
  plist)

(defun dim-show (&optional fmt)
  (let ((*print-pretty* nil))
    (loop for plist in dim-saved
	  do (format t (or fmt "~a~%") plist))))

(defun dim-show-S ()
  (dim-show "~S~%"))

;; «my-reverse»  (to ".my-reverse")
(defun my-reverse-nnlist (abcd)
  (let* ((a (car abcd))
	 (b (cadr abcd))
	 (cd (cddr abcd)))
    `(,a ,b ,@(my-reverse cd))))

(defun my-reverse-otherlist (list)
  (reverse (mapcar #'my-reverse list)))

(defun my-reverse (o)
  (if (listp o)
      (if (numberp (car o))
	  (my-reverse-nnlist o)
	  (my-reverse-otherlist o))
      o))

#|
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("2025-dim-save.lisp");
to_lisp();
  (my-reverse '(:a (2 3 :b :c) (:d :e) :f))
  (to-maxima)

|#


;; `dimension-superscript-saving-1' saves a lot of information.
;; `dimension-superscript-saving-2' saves just the essential.

(defun dimension-superscript-saving-1 (form result)
  (dim-save :pos 1 :form form :result result)
  (let ((out (dimension-superscript form result)))
    (dim-save :pos 2 :form form :result result :out out)
    out))

(defun dimension-superscript-saving-2 (form result)
  (let ((out (dimension-superscript form result)))
    (dim-save :rev-out (my-reverse out))
    out))

(displa-def mexpt  dimension-superscript-saving-2)
(displa-def %mexpt dimension-superscript-saving-2)


#|
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("2025-dim-save.lisp");
a^b;
a^bc;
ab^cd;
ab^(cd^ef);
ab^(cd^(ef[gh]));
:lisp (dim-show)

to_lisp();
  (defvar o)
  (setq o (nth 5 dim-saved))
  (setq o (getf o :out))
  (reverse o)
  (my-reverse o)

  (my-reverse '(2 3 :a :b))  
  (my-reverse '(:c (2 3 :a :b) :d))
  (numberp #\a)

  (getf '(1 2 3 4) :out)

|#


;; «contract-chars»  (to ".contract-chars")
(defun contract-chars (o)
  (cond ((null o) nil)
	((atom o) o)
	((characterp (car o))
	 (let ((chars ()))
	   (loop while (characterp (car o))
		 do (push (car o) chars)
		 do (setq o (cdr o)))
	   (cons (coerce chars 'string)
		 (contract-chars o))))
	(t (cons (contract-chars (car o))
		 (contract-chars (cdr o))))))


;; «contract-chars-tests»  (to ".contract-chars-tests")
#|
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("2025-dim-save.lisp");
to_lisp();
  (defvar o)
  (setq o '(1 2 #\a #\b #\c 3 4 #\d #\e 5))
  (contract-chars o)
  (to-maxima)

|#


(defun dim-$matrix-saving (form result)
  (let ((out (dim-$matrix form result)))
    (dim-save :con-out (contract-chars out))
    out))

;; (displa-def $matrix dim-$matrix)
;; (displa-def %matrix dim-$matrix)
;; (displa-def $matrix dim-$matrix-saving)
;; (displa-def %matrix dim-$matrix-saving)

#|
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("2025-dim-save.lisp");
to_lisp();
  (displa-def $matrix dim-$matrix-saving)
  (displa-def %matrix dim-$matrix-saving)
  (to-maxima)

display_matrix_brackets: false$
matrix([A],[B],[C],[D]);
matrix([Aa],[Bb],[Cc],[Dd]);
matrix([Aaa],[Bbb],[Ccb],[Ddd]);
matrix([box(a^b)]);
matrix([box(ab^cd)]);

:lisp (dim-show-S)

:lisp (d-box nil 1 2 3 nil)

matrix([a,b], [c,d]);
matrix([Aa,Bb,Ccc], [Dd,Ed,Fff]);

|#


;; «testdispla-redef»  (to ".testdispla-redef")

(setf (get '$testdispla 'dimension) 'dim-testdispla)

(defun dim-testdispla (form result)	; initial definition, for tests
  (declare (ignorable form))
  (dim-$matrix #$matrix([a,b],[c,d])$ result))

(defun testdispla-as-string ()
  (with-output-to-string (*standard-output*)
    (maxima-display #$testdispla()$)))

(defun testdispla-redef-0 (body)
  `(defun dim-testdispla (form result)
     (declare (ignorable form))
     ,body))

(defun testdispla-redef (body)
  (eval (testdispla-redef-0 body))
  (testdispla-as-string))

(defvar testdispla-inner)

(setq testdispla-inner '(dim-$matrix #$matrix([a,b],[c,d])$ result))

(defun testdispla-wrap (inner)
  `(progn (dim-save :pos 1 :form form :result result)
	  (let ((out ,inner))
	    (dim-save :pos 2 :form form :result result :out out)
	    out)))


(defclass testdispla ()
  ((form      :initarg :form      :initform #$a+b$)
   (dim       :initarg :dim       :initform nil)
   (save      :initarg :save      :initform t)
   (innersave :initarg :innersave :initform '(:form form :result result))
   ))

(defun make-testdispla (&rest args)
  (apply 'make-instance 'testdispla args))

(defmethod td-innerbody ((td testdispla))
  (with-slots (form dim) td
    (let ((dim-this (or dim (get (caar form) 'dimension))))
      `(,dim-this ',form result))))

(defmethod td-outerbody ((td testdispla))
  (with-slots (save innersave) td
    (if (not save)
	(td-innerbody td)
	`(progn (dim-save :pos 1 ,@innersave)
	  (let ((out ,(td-innerbody td)))
	    (dim-save :pos 2 ,@innersave :out out)
	    out)))))

(setf (get '$testdispla 'dimension) 'dim-testdispla)

(defmethod td-defun-dim ((td testdispla))
  `(defun dim-testdispla (form result)
     (declare (ignorable form))
     ,(td-outerbody td)))

(defmethod td-redef ((td testdispla))
  (eval (td-defun-dim td)))

(defun td-output-as-string ()
  (with-output-to-string (*standard-output*)
    (maxima-display #$testdispla()$)))


#|
** «testdispla-redef-tests»  (to ".testdispla-redef-tests")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("2025-dim-save.lisp");
to_lisp();
  (defvar mytd)
  (td-innerbody (make-testdispla))
  (td-innerbody (make-testdispla :form #$c*d$))
  (td-innerbody (make-testdispla :form #$c*d$ :dim 'dim-foo))
  (td-outerbody (make-testdispla :save nil))
  (td-outerbody (make-testdispla))
  (td-outerbody (make-testdispla :innersave '(:height height)))
  (td-defun-dim (make-testdispla))
  (td-redef     (make-testdispla))
  (td-output-as-string)

  (setq mytd (make-testdispla))
  (td-innerbody mytd)

  (setq mytd (make-instance 'testdispla))
  (setq mytd (make-instance 'testdispla :form #$a+b$))
  (setq mytd (make-instance 'testdispla :form #$a+b$ :dim 'dim-foo))
  (setq mytd (make-testdispla))
  (setq mytd (make-testdispla :form #$a+b$))
  (setq mytd (make-testdispla :form #$a+b$ :dim 'dim-foo))
  (describe mytd)
  (setq mytd (make-testdispla))
  (td-innerbody mytd)


testdispla();


to_lisp();
  (testdispla-as-string)
  (testdispla-redef-0 '(dim-$matrix #$matrix([a,b],[c,d])$ result))
  (testdispla-redef   '(dim-$matrix #$matrix([a,b],[c,d])$ result))
  (testdispla-redef   '(dim-$matrix #$matrix([2,3],[4,5])$ result))
  (testdispla-wrap testdispla-inner)
  (to-maxima)

  (dim-save :pos 1 :form form :result result)
  (let ((out (dimension-superscript form result)))
    (dim-save :pos 2 :form form :result result :out out)
    out))


|#




;; (find-maximagitfile "src/displa.lisp" ";;; BKPT")
;; (find-maximagitfile "src/displa.lisp" "(defun dim-mbox ")
;; (find-maximagitfile "src/displa.lisp" "(defun dim-mbox " "(nreverse dummy)")
;; (find-maximagitfile "src/displa.lisp" "(defun d-box ")







;; Local Variables:
;; coding:  utf-8-unix
;; End: