diff options
| -rw-r--r-- | src/guile/skribilo/package/eq.scm | 113 | ||||
| -rw-r--r-- | src/guile/skribilo/package/eq/lout.scm | 38 |
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 >) |