diff options
| -rw-r--r-- | src/guile/skribilo/package/eq.scm | 49 | ||||
| -rw-r--r-- | src/guile/skribilo/package/eq/lout.scm | 38 |
2 files changed, 70 insertions, 17 deletions
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm index 410f04f..058320f 100644 --- a/src/guile/skribilo/package/eq.scm +++ b/src/guile/skribilo/package/eq.scm @@ -51,13 +51,54 @@ ;;; (define %operators - '(/ * + - = != ~= < > <= >= sqrt expt sum product script)) + '(/ * + - = != ~= < > <= >= sqrt expt sum product script in notin)) + +(define %symbols + ;; A set of symbols that are automatically recognized within an `eq' quoted + ;; list. + '(;; lower-case Greek + alpha beta gamma delta epsilon zeta eta theta iota kappa + lambda mu nu xi omicron pi rho sigma tau upsilon phi chi omega + + ;; upper-case Greek + Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota Kappa + Lambda Mu Nu Xi Omicron Pi Rho Sigma Tau Upsilon Phi Chi Omega + + ;; Hebrew + alef + + ;; mathematics + ellipsis weierp image real forall partial exists + emptyset infinity in notin nabla nipropto angle and or cap cup + 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))) + ;; initialize a hash table equivalent to LST + (for-each (lambda (s) (hashq-set! h s #t)) lst) + + ;; the run-time, fast, definition + (lambda (sym) + (hashq-ref h sym #f)))) + +(define-public known-operator? (make-fast-member-predicate %operators)) +(define-public known-symbol? (make-fast-member-predicate %symbols)) + +(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)))) + (define (eq:symbols->strings equation) "Turn symbols located in non-@code{car} positions into strings." @@ -67,7 +108,9 @@ (cons (car equation) ;; XXX: not tail-recursive (map eq:symbols->strings (cdr equation))))) ((symbol? equation) - (symbol->string equation)) + (if (known-symbol? equation) + `(symbol ,(symbol->string equation)) + (symbol->string equation))) (else equation))) (define-public (eq-evaluate equation) @@ -138,6 +181,8 @@ (options (the-options opts)) (body (the-body opts)))) +(define-simple-markup eq:in) +(define-simple-markup eq:notin) ;;; diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm index 30a6d39..6469bea 100644 --- a/src/guile/skribilo/package/eq/lout.scm +++ b/src/guile/skribilo/package/eq/lout.scm @@ -120,21 +120,29 @@ (simple-lout-markup-writer <=) (simple-lout-markup-writer >=) -(markup-writer 'eq:expt (find-engine 'lout) - :action (lambda (node engine) - (let ((body (markup-body node))) - (if (= (length body) 2) - (let ((base (car body)) - (expt (cadr body))) - (display " { { ") - (if (markup? base) (display "(")) - (output base engine) - (if (markup? base) (display ")")) - (display " } sup { ") - (output expt engine) - (display " } } ")) - (skribe-error 'eq:expt "wrong number of arguments" - body))))) +(define-macro (binary-lout-markup-writer sym lout-name) + `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout) + :action (lambda (node engine) + (let ((body (markup-body node))) + (if (= (length body) 2) + (let* ((first (car body)) + (second (cadr body)) + (parentheses? (equation-markup? first))) + (display " { { ") + (if parentheses? (display "(")) + (output first engine) + (if parentheses? (display ")")) + (display ,(string-append " } " lout-name " { ")) + (output second engine) + (display " } } ")) + (skribe-error ,(symbol-append 'eq: sym) + "wrong number of arguments" + body)))))) + +(binary-lout-markup-writer expt "sup") +(binary-lout-markup-writer in "element") +(binary-lout-markup-writer notin "notelement") + |