summaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/package/eq.scm49
-rw-r--r--src/guile/skribilo/package/eq/lout.scm38
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")
+