eq: Handle operator precedence when parenthesizing.

* src/guile/skribilo/package/eq.scm (equation-markup-name?): New.
  (equation-markup?): Use it.
  (equation-markup-name->operator): New.
  (%operator-precedence): New.
  (operator-precedence): New.

* src/guile/skribilo/package/eq/lout.scm (simple-markup-writer): Take
  operator precedence into account.

git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-1

2 files changed, 111 insertions, 40 deletions

diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 06aa862..1b0b4aa 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -76,10 +76,6 @@
     sim cong approx neq equiv le ge subset supset subseteq supseteq
     oplus otimes perp mid lceil rceil lfloor rfloor langle rangle))
 
-(define %rebindings
-  (map (lambda (sym)
-	 (list sym (symbol-append 'eq: sym)))
-       %operators))
 
 (define (make-fast-member-predicate lst)
   (let ((h (make-hash-table)))
@@ -93,15 +89,60 @@
 (define-public known-operator? (make-fast-member-predicate %operators))
 (define-public known-symbol? (make-fast-member-predicate %symbols))
 
+(define-public equation-markup-name?
+  (make-fast-member-predicate (map (lambda (s)
+				     (symbol-append 'eq: s))
+				   %operators)))
+
 (define-public (equation-markup? m)
   "Return true if @var{m} is an instance of one of the equation sub-markups."
-  (define eq-sym?
-    (make-fast-member-predicate (map (lambda (s)
-				       (symbol-append 'eq: s))
-				     %operators)))
   (and (markup? m)
-       (eq-sym? (markup-markup m))))
+       (equation-markup-name? (markup-markup m))))
+
+(define-public (equation-markup-name->operator m)
+  "Given symbol @var{m} (an equation markup name, e.g., @code{eq:+}), return
+a symbol representing the mathematical operator denoted by @var{m} (e.g.,
+@code{+})."
+  (if (equation-markup-name? m)
+      (string->symbol (let ((str (symbol->string m)))
+			(substring str
+				   (+ 1 (string-index str #\:))
+				   (string-length str))))
+      #f))
+
+
+;;;
+;;; Operator precedence.
+;;;
+
+(define %operator-precedence
+  ;; FIXME: This needs to be augmented.
+  '((+ . 1)
+    (- . 1)
+    (* . 2)
+    (/ . 2)
+    (sum . 3)
+    (product . 3)
+    (= . 0)
+    (< . 0)
+    (> . 0)
+    (<= . 0)
+    (>= . 0)))
+
+(define-public (operator-precedence op)
+  (let ((p (assq op %operator-precedence)))
+    (if (pair? p) (cdr p) 0)))
+
+
+
+;;;
+;;; Turning an S-exp into an `eq' markup.
+;;;
 
+(define %rebindings
+  (map (lambda (sym)
+	 (list sym (symbol-append 'eq: sym)))
+       %operators))
 
 (define (eq:symbols->strings equation)
   "Turn symbols located in non-@code{car} positions into strings."
@@ -122,6 +163,7 @@
   (eval `(let ,%rebindings ,(eq:symbols->strings equation))
 	(current-module)))
 
+
 
 ;;;
 ;;; Markup.
@@ -209,13 +251,13 @@
 					   body))
 			 (loop (cdr body) (cons first result)))))))))
 
+
 
 ;;;
-;;; Base and text-only implementation.
+;;; Text-based rendering.
 ;;;
 
 
-
 (markup-writer 'eq (find-engine 'base)
    :action (lambda (node engine)
 	     ;; The `:renderer' option should be a symbol (naming an engine
@@ -247,24 +289,37 @@
 				    renderer))))))
 
 (define-macro (simple-markup-writer op . obj)
-  `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base)
-     :action (lambda (node engine)
-		(let loop ((operands (markup-body node)))
-		 (if (null? operands)
-		     #t
-		     (let ((o (car operands)))
-		       (display (if (equation-markup? o) "(" ""))
-		       (output o engine)
-		       (display (if (equation-markup? o) ")" ""))
-		       (if (pair? (cdr operands))
-			   (begin
-			     (display " ")
-			     (output ,(if (null? obj)
-					  (symbol->string op)
-					  (car obj))
-				     engine)
-			     (display " ")))
-		       (loop (cdr operands))))))))
+  ;; Note: The text-only rendering is less ambiguous if we parenthesize
+  ;; without taking operator precedence into account.
+  (let ((precedence (operator-precedence op)))
+    `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base)
+       :action (lambda (node engine)
+		  (let loop ((operands (markup-body node)))
+		   (if (null? operands)
+		       #t
+		       (let* ((o (car operands))
+			      (nested-eq? (equation-markup? o))
+			      (need-paren?
+			       (and nested-eq?
+; 				    (< (operator-precedence
+; 					(equation-markup-name->operator
+; 					 (markup-markup o)))
+; 				       ,precedence)
+				    )
+			       ))
+
+			 (display (if need-paren? "(" ""))
+			 (output o engine)
+			 (display (if need-paren? ")" ""))
+			 (if (pair? (cdr operands))
+			     (begin
+			       (display " ")
+			       (output ,(if (null? obj)
+					    (symbol->string op)
+					    (car obj))
+				       engine)
+			       (display " ")))
+			 (loop (cdr operands)))))))))
 
 (simple-markup-writer +)
 (simple-markup-writer -)
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index 1df96c1..4de515e 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -67,14 +67,18 @@
 
 
 (define-macro (simple-lout-markup-writer sym . args)
-  (let ((lout-name (if (null? args)
-		       (symbol->string sym)
-		       (car args)))
-	(parentheses? (if (or (null? args) (null? (cdr args)))
-			  #f
-			  (cadr args)))
-	(open-par '(if eq-op? "(" ""))
-	(close-par '(if eq-op? ")" "")))
+  (let* ((lout-name (if (null? args)
+			(symbol->string sym)
+			(car args)))
+	 (parentheses? (if (or (null? args) (null? (cdr args)))
+			   #t
+			   (cadr args)))
+	 (precedence (operator-precedence sym))
+
+	 ;; Note: We could use `pmatrix' here but it precludes line-breaking
+	 ;; within equations.
+	 (open-par `(if need-paren? "{ @VScale ( }" ""))
+	 (close-par `(if need-paren? "{ @VScale ) }" "")))
 
     `(markup-writer ',(symbol-append 'eq: sym)
 		    (find-engine 'lout)
@@ -83,7 +87,19 @@
 				(if (null? operands)
 				    #t
 				    (let* ((op (car operands))
-					   (eq-op? (equation-markup? op)))
+					   (eq-op? (equation-markup? op))
+					   (need-paren?
+					    (and eq-op?
+						 (< (operator-precedence
+						     (equation-markup-name->operator
+						      (markup-markup op)))
+						    ,precedence)))
+					   (column (port-column
+						    (current-output-port))))
+
+				      ;; Work around Lout's limitations...
+				      (if (> column 1000) (display "\n"))
+
 				      (display (string-append " { "
 							      ,(if parentheses?
 								   open-par
@@ -107,8 +123,8 @@
 
 (simple-lout-markup-writer +)
 (simple-lout-markup-writer * "times")
-(simple-lout-markup-writer - "-" #t)
-(simple-lout-markup-writer / "over")
+(simple-lout-markup-writer - "-")
+(simple-lout-markup-writer / "over" #f)
 (simple-lout-markup-writer =)
 (simple-lout-markup-writer <)
 (simple-lout-markup-writer >)