
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; MODULE      : giac-input.scm
;; DESCRIPTION : Giac input converters
;; COPYRIGHT   : (C) 1999  Joris van der Hoeven
;;               (C) 2020  Luka Marohnić
;;
;; This software falls under the GNU general public license version 3 or later.
;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(texmacs-module (giac-input)
  (:use (utils plugins plugin-convert)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Specific conversion routines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (giac-input-var-row r)
  (if (nnull? r)
      (begin
	(display ",")
	(plugin-input (car r))
	(giac-input-var-row (cdr r)))))

(define (giac-input-row r)
  (display "[")
  (plugin-input (car r))
  (giac-input-var-row (cdr r))
  (display "]"))

(define (giac-input-var-rows t)
  (if (nnull? t)
      (begin
	(display ",")
	(giac-input-row (car t))
	(giac-input-var-rows (cdr t)))))

(define (giac-input-rows t)
  (display "[")
  (giac-input-row (car t))
  (giac-input-var-rows (cdr t))
  (display "]"))

(define (giac-input-binom args)
  (display "comb(")
  (plugin-input (car args))
  (display ",")
  (plugin-input (cadr args))
  (display ")"))

(define (giac-input-prime args)
  (if (nnull? args)
    (display (car args))))

(define (giac-input-int args)
  (display "int(")
  (plugin-input (car args))
  (if (nnull? (cdr args))
    (begin
      (display ",")
      (plugin-input (cadr args))
      (if (nnull? (cddr args))
	(begin
	  (display ",")
	  (plugin-input (caddr args)))))))

(define (giac-input-sum args)
  (display "sum(")
  (plugin-input (car args))
  (if (nnull? (cdr args))
    (begin
      (display ",")
      (plugin-input (cadr args))
      (if (nnull? (cddr args))
        (begin
          (display "..")
          (plugin-input (caddr args)))))))

(define (giac-input-prod args)
  (display "product(")
  (plugin-input (car args))
  (if (nnull? (cdr args))
    (begin
      (display ",")
      (plugin-input (cadr args))
      (if (nnull? (cddr args))
        (begin
          (display "..")
          (plugin-input (caddr args)))))))

(define (giac-input-big-around args)
  (let* ((b `(big-around ,@args))
         (op (big-name b))
         (sub (big-subscript b))
         (sup (big-supscript b))
         (body (big-body b))
         (l (cond ((and sub sup)
		   (list body sub sup))
                  (sub (list body sub))
                  (else (list body)))))
    (cond ((== op "sum")
	   (giac-input-sum l))
          ((== op "prod")
	   (giac-input-prod l))
          ((== op "int")
	   (giac-input-int l))
          (else (display op)
		(display "(")
		(plugin-input body)))
    (display ")")))

(define (giac-input-around* args)
  (let* ((opn (car args))
	 (body (cadr args))
	 (cls (caddr args)))
    (cond ((and (== opn "|")
		(== cls "|"))
	   (begin
	     (display "abs(")
	     (plugin-input body)
	     (display ")")))
	  ((and (== opn "<||>")
		(== cls "<||>"))
	   (begin
	     (display "l2norm(")
	     (plugin-input body)
	     (display ")")))
	  ((and (== opn "{")
		(== cls "}"))
	   (begin
	     (display "%{")
	     (plugin-input body)
	     (display "%}")))
	  ((and (== opn "<llbracket>")
		(== cls "<rrbracket>"))
	   (begin
	     (display "poly1[")
	     (plugin-input body)
	     (display "]")))
	  ((and (== opn "<lfloor>")
		(== cls "<rfloor>"))
	   (begin
	     (display "floor(")
	     (plugin-input body)
	     (display ")")))
	  ((and (== opn "<lceil>")
		(== cls "<rceil>"))
	   (begin
	     (display "ceil(")
	     (plugin-input body)
	     (display ")")))
	  ((and (== opn "<nobracket>")
		(== cls "<nobracket>"))
	   (begin
	     (display "(")
	     (plugin-input body)
	     (display ")")))
	  (else
	    (if (not (== opn "<nobracket>"))
	      (display opn))
	    (plugin-input body)
	    (display cls)))))

(define (giac-input-upright args)
  (let* ((op (if (nnull? args)
	       (car args)
	       "")))
    (cond ((== op "<delta>") (display "Dirac"))
	  ((== op "<theta>") (display "Heaviside"))
	  ((== op "<zeta>") (display "Zeta"))
	  (else (plugin-input op)))))

(define (giac-input-subscript args)
  (let* ((sub (car args)))
    (if (or (string? sub)
	    (and (nnull? sub)
		 (== 'math-up (car sub))))
      (cond ((== sub "<oplus>")
	     (display "Earth"))
	    ((== sub "<odot>")
	     (display "Sun"))
	    (else (plugin-input sub)))
      (begin
	(display "[")
	(if (and (== 'around* (car sub))
		 (== "<nobracket>" (cadr sub))
		 (== "<nobracket>" (cadddr sub)))
	  (plugin-input (caddr sub))
	  (plugin-input sub))
	(display "]")))))

(define (giac-input-bf args)
  (let* ((s (car args)))
    (if (and (string? s)
	     (== (string-length s) 1))
      (begin
	(display s)
	(display s))
      (plugin-input s))))

(define (giac-input-degreesign args)
  (display "deg"))

(define (giac-input-accent args)
  (let* ((body (car args))
	 (ac (cadr args)))
    (cond ((== ac "<bar>")
	   (begin
	     (display "conj(")
	     (plugin-input body)
	     (display ")")))
	  ((== ac "<dot>")
	   (begin
	     (display "(")
	     (plugin-input body)
	     (display ")'")))
	  ((== ac "<ddot>")
	   (begin
	     (display "(")
	     (plugin-input body)
	     (display ")''")))
	  (else (plugin-input body)))))

(define (giac-input-exponent args)
  (let* ((e (car args)))
    (if (string? e)
      (cond ((== e "+") (display ",1"))
	    ((== e "-") (display ",-1"))
	    (else (begin
		    (display "^(")
		    (plugin-input e)
		    (display ")"))))
      (let* ((n (if (and (nnull? e)
			(== 'around* (car e))
			(== "(" (cadr e))
			(== ")" (cadddr e))
			(string? (caddr e)))
		 (string->number (caddr e))
		 #f)))
	(if (integer? n)
	  (display (make-string n #\'))
	  (begin
	    (display "^(")
	    (plugin-input e)
	    (display ")")))))))

(define (lim-suffix? arg)
  (and (string? arg)
       (<= 3 (string-length arg))
       (string-suffix? "lim" arg)
       (or (== 3 (string-length arg))
	   (let* ((chr (cadddr (reverse (string->list arg)))))
	     (and (not (char-alphabetic? chr))
		  (not (char-numeric? chr))
		  (not (== chr #\_)))))))

(define (dny opr arg)
  (let* ((len (string-length opr)))
    (cond ((and (string? arg)
		(string-prefix? opr arg))
	   (list opr 1 (string-trim (substring arg len))))
	  ((and (list? arg)
	        (== 'concat (car arg))
		(string? (cadr arg))
		(string-prefix? opr (cadr arg)))
	   (let* ((frst (cadr arg))
		  (rest (cddr arg)))
	     (cond ((< len (string-length frst))
		    (list opr 1 (cons 'concat (cons (substring frst len) rest))))
		   ((and (== len (string-length frst))
			 (list? (car rest))
			 (== 'rsup (caar rest))
			 (string? (cadar rest)))
		    (let* ((n (string->number (cadar rest))))
		      (if (and (integer? n)
			       (> n 0))
			(list opr n (if (nnull? (cdr rest))
				      (cons 'concat (cdr rest))
				      ""))
			#f)))
		   (else #f))))
	  (else #f))))

(define (derive-vars opr args)
  (if (nnull? args)
    (append (cond ((string? (car args))
		   (list (string-replace (string-replace (car args) "*" "") opr ",")))
		  ((== 'rsup (caar args))
		   (cons "$" (cdar args)))
		  (else (list (car args))))
	    (derive-vars opr (cdr args)))
    '()))

(define (application? args)
  (and (list? args)
       (nnull? args)
       (nnull? (cdr args))
       (nnull? (cddr args))
       (== " " (cadr args))
       (list? (caddr args))
       (== 'around* (caaddr args))
       (or (== "(" (car (cdaddr args)))
	   (== "<nobracket>" (caddr (cdaddr args))))))

(define (giac-input-concat args)
  (if (nnull? args)
    (cond ((application? args) 
	   (let* ((opr (car args))
		  (nmr (and (== 'frac (car opr))
			    (or (string? (caddr opr))
				(== 'concat (caaddr opr)))
			    (or (dny "<mathd>" (cadr opr))
				(dny "<partial>" (cadr opr)))))
		  (arg (cadr (cdaddr args))))
	     (cond ((== 'rsup (car opr))
		    (begin
		      (display "(")
		      (plugin-input arg)
		      (display ")^(")
		      (plugin-input (cadr opr))
		      (display ")")
		      (giac-input-concat (cdddr args))))
		   ((and (list? nmr)
			 (== "" (caddr nmr)))
		    (begin
		      (display "diff(")
		      (plugin-input arg)
		      (plugin-input (cons 'concat
					  (derive-vars
					    (car nmr)
					    (if (string? (caddr opr))
					      (cddr opr)
					      (cdaddr opr)))))
		      (display ")")
		      (giac-input-concat (cdddr args))))
		   (else (plugin-input (car args))
			 (giac-input-concat (cdr args))))))
	  ((and (application? (cdr args))
		(lim-suffix? (car args))
		(list? (cadr args))
		(== 'rsub (caadr args)))
	   (begin
	     (plugin-input (string-drop-right (car args) 3))
	     (display "limit(")
	     (plugin-input (caddr (cadddr args)))
	     (display ",")
	     (plugin-input (cadadr args))
	     (display ")")
	     (giac-input-concat (cddddr args))))
	  (else (plugin-input (car args))
		(giac-input-concat (cdr args))))))

(define (giac-input-frac args)
  (let* ((nmr (and (or (string? (cadr args))
		       (== 'concat (caadr args)))
		   (or (dny "<mathd>" (car args))
		       (dny "<partial>" (car args))))))
    (if (and (list? nmr)
	     (not (== "" (caddr nmr))))
      (begin
	(display "diff(")
	(plugin-input (caddr nmr))
	(plugin-input (cons 'concat
			    (derive-vars
			      (car nmr)
			      (if (string? (cadr args))
				(cdr args)
				(cdadr args)))))
	(display ")"))
      (begin
	(display "((")
	(plugin-input (car args))
	(display ")/(")
	(plugin-input (cadr args))
	(display "))")))))

(define (giac-input-mid arg)
  (if (== "|" arg)
    (display "$")
    (plugin-input arg)))

(define (giac-input-choice-rows args)
  (if (nnull? args)
    (let* ((r (car args))
	   (e (cadadr r))
	   (c (car (cdaddr r)))
	   (f (cond ((and (string? e)
			  (string-suffix? "," e))
		     (string-drop-right e 1))
		    ((and (list? e)
			  (== 'concat (car e))
			  (string? (car (reverse (cdr e)))))
		     (let* ((lst (reverse (cdr e)))
			    (str (car lst)))
		       (cons 'concat
			     (reverse (cons (if (string-suffix? "," str)
					      (string-drop-right str 1)
					      str)
					    (cdr lst))))))
		    (else e))))
      (if (not (or (and (string? c)
			(string-prefix? "otherwise" c))
		   (and (list? c)
			(== 'text (car c)))))
	(begin
	  (plugin-input c)
	  (display ",")))
      (plugin-input f)
      (if (nnull? (cdr args))
	(display ","))
      (giac-input-choice-rows (cdr args)))))

(define (giac-input-choice args)
  (display "piecewise(")
  (giac-input-choice-rows (cdadar args))
  (display ")"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(plugin-input-converters giac
  (rows giac-input-rows)
  (concat giac-input-concat)
  (choice giac-input-choice)
  (mid giac-input-mid)
  (frac giac-input-frac)
  (frac* giac-input-frac)
  (binom giac-input-binom)
  (rprime giac-input-prime)
  (rsub giac-input-subscript)
  (math-up giac-input-upright)
  (math-bf giac-input-bf)
  (big-around giac-input-big-around)
  (degreesign giac-input-degreesign)
  (wide giac-input-accent)
  (rsup giac-input-exponent)
  (around* giac-input-around*)
  ("<mathpi>" "pi")
  ("<mathi>" "i")
  ("<mathd>" "1,")
  ("<matheuler>" "euler_gamma")
  ("<mathe>" "e")
  ("<up-delta>" "Dirac")
  ("<up-theta>" "Heaviside")
  ("<up-zeta>" "Zeta")
  ("<Re>" "re")
  ("<Im>" "im")
  ("<infty>" "infinity")
  ("<cdots>" "..")
  ("<emptyset>" "%{NULL%}")
  ("<setminus>" " minus ")
  ("<cup>" " union ")
  ("<cap>" " intersect ")
  ("<space>" " ")
  ("<varepsilon>" "epsilon()")
  ("<oplus>" ".+")
  ("<ominus>" ".-")
  ("<odot>" ".*")
  ("<oslash>" "./")
  ("<noplus>" "+")
  ("<nocomma>" ",")
  ("<nosymbol>" "_")
  ("<AA>" "Angstrom")
  ("<mapsto>" "->")
  ("<bbb-Z>" "DOM_INT")
  ("<bbb-Q>" "DOM_RAT")
  ("<bbb-R>" "DOM_FLOAT")
  ("<bbb-C>" "DOM_COMPLEX")
  ("<rightarrow>" "=")
  ("<leftarrow>" "=<")
  ("<longequal>" "==")
  ("<neq>" "!=")
  ("<barsuchthat>" "$")
  ("<in>" " in ")
  ("<b-up-a>" "aa")
  ("<b-up-b>" "bb")
  ("<b-up-c>" "cc")
  ("<b-up-d>" "dd")
  ("<b-up-e>" "ee")
  ("<b-up-f>" "ff")
  ("<b-up-g>" "gg")
  ("<b-up-h>" "hh")
  ("<b-up-i>" "ii")
  ("<b-up-j>" "jj")
  ("<b-up-k>" "kk")
  ("<b-up-l>" "ll")
  ("<b-up-m>" "mm")
  ("<b-up-n>" "nn")
  ("<b-up-o>" "oo")
  ("<b-up-p>" "pp")
  ("<b-up-q>" "qq")
  ("<b-up-r>" "rr")
  ("<b-up-s>" "ss")
  ("<b-up-t>" "tt")
  ("<b-up-u>" "uu")
  ("<b-up-v>" "vv")
  ("<b-up-w>" "ww")
  ("<b-up-x>" "xx")
  ("<b-up-y>" "yy")
  ("<b-up-z>" "zz")
  ("<b-up-A>" "AA")
  ("<b-up-B>" "BB")
  ("<b-up-C>" "CC")
  ("<b-up-D>" "DD")
  ("<b-up-E>" "EE")
  ("<b-up-F>" "FF")
  ("<b-up-G>" "GG")
  ("<b-up-H>" "HH")
  ("<b-up-I>" "II")
  ("<b-up-J>" "JJ")
  ("<b-up-K>" "KK")
  ("<b-up-L>" "LL")
  ("<b-up-M>" "MM")
  ("<b-up-N>" "NN")
  ("<b-up-O>" "OO")
  ("<b-up-P>" "PP")
  ("<b-up-Q>" "QQ")
  ("<b-up-R>" "RR")
  ("<b-up-S>" "SS")
  ("<b-up-T>" "TT")
  ("<b-up-U>" "UU")
  ("<b-up-V>" "VV")
  ("<b-up-W>" "WW")
  ("<b-up-X>" "XX")
  ("<b-up-Y>" "YY")
  ("<b-up-Z>" "ZZ"))
