SMathML Reference

This is the English translation of the Chinese version of this reference.

SMathML is still a fast-moving project, so this reference may be out of date. Where the two disagree, the implementation is authoritative.

第1章 Introduction

SMathML is not a typesetting engine; at present it delegates all typesetting work to the browser. In principle, typesetting could be delegated not only to the browser but also to other backends such as LaTeX, through a transformation or output process (in which case output is itself a kind of transformation). Its model, however, is based on the browser. That is, what it provides are means of expressing HTML and MathML. (It also takes CSS and SVG into account, but that support is far from complete and hardly usable.) Even if someone did design and implement another backend, it would be indirect, and it was never the author's intention.

The purpose of SMathML is to provide a mature way of writing mathematical content on the web. Even so, the popularity of other software and libraries such as MathJax might make SMathML seem unnecessary. The problem is that almost none of these popular choices provides the necessary means of abstraction and combination. This problem has not received much attention, because LaTeX, the de facto standard for mathematical typesetting, is already hard to praise when it comes to abstraction and combination. (Moreover, most software and libraries offer only a restricted imitation of LaTeX, which weakens abstraction and combination even further.) Nevertheless, the problem is real, and that is why the author designed and implemented SMathML.

SMathML is currently a DSL embedded in Racket. In other words, users can enjoy the whole Racket ecosystem without restriction, in sharp contrast with some other typesetting systems, such as Typst. Embedding it in other Scheme implementations may be possible, but since SMathML freely uses Racket's own keyword argument mechanism, a compatibility layer may not be easy to implement. Users could, however, choose to start afresh and change some of SMathML's own means of expression.

SMathML is based on SXML, which can be understood as a direct list representation of XML in Scheme/Lisp. SXML could perhaps also be understood as a syntax, but that view is both unnecessary and too restrictive, so we do not adopt it. The reason is that SMathML's expressive power comes from its ability to manipulate and transform SXML directly. Our SXML is not exactly the same as Oleg Kiselyov's SXML, whereas the SXML library provided by Racket follows Oleg Kiselyov's design. The difference is that in our SXML the attribute list is mandatory: when there are no attributes, an empty list is used, which makes the representation more uniform. This does make writing bare SXML more tedious. However, since many basic functions are provided, this is no problem at all in actual use of SMathML. SMathML also provides a transformation mechanism similar to Oleg Kiselyov's SXSLT, but it offers only a small part of SXSLT's functionality. For now, at least, the author considers that sufficient.

第2章 Basic Functions

This chapter is a reference for the most basic functions, which express MathML and HTML in SXML form. There is nothing surprising here; a quick skim is enough to master it completely.

第2.1节 The MathML Part

(define (Math #:attr* [attr* '()] . mathml*)
  `(math ,attr* . ,mathml*))

Here are all the basic functions of the MathML part.

(define (Math #:attr* [attr* '()] . mathml*)
  `(math ,attr* . ,mathml*))
(define (Merror #:attr* [attr* '()] . mathml*)
  `(merror ,attr* . ,mathml*))
(define (Mfrac #:attr* [attr* '()] . mathml*)
  `(mfrac ,attr* . ,mathml*))
(define (Mi #:attr* [attr* '()] . mathml*)
  `(mi ,attr* . ,mathml*))
(define (Mmultiscripts #:attr* [attr* '()] . mathml*)
  `(mmultiscripts ,attr* . ,mathml*))
(define (Mprescripts #:attr* [attr* '()] . mathml*)
  `(mprescripts ,attr* . ,mathml*))
(define (Mn #:attr* [attr* '()] . mathml*)
  `(mn ,attr* . ,mathml*))
(define (Mo #:attr* [attr* '()] . mathml*)
  `(mo ,attr* . ,mathml*))
(define (Mover #:attr* [attr* '()] . mathml*)
  `(mover ,attr* . ,mathml*))
(define (Mpadded #:attr* [attr* '()] . mathml*)
  `(mpadded ,attr* . ,mathml*))
(define (Mphantom #:attr* [attr* '()] . mathml*)
  `(mphantom ,attr* . ,mathml*))
(define (Mroot #:attr* [attr* '()] . mathml*)
  `(mroot ,attr* . ,mathml*))
(define (Mrow #:attr* [attr* '()] . mathml*)
  `(mrow ,attr* . ,mathml*))
(define (Ms #:attr* [attr* '()] . mathml*)
  `(ms ,attr* . ,mathml*))
(define (Mspace #:attr* [attr* '()] . mathml*)
  `(mspace ,attr* . ,mathml*))
(define (Msqrt #:attr* [attr* '()] . mathml*)
  `(msqrt ,attr* . ,mathml*))
(define (Mstyle #:attr* [attr* '()] . mathml*)
  `(mstyle ,attr* . ,mathml*))
(define (Msub #:attr* [attr* '()] . mathml*)
  `(msub ,attr* . ,mathml*))
(define (Msubsup #:attr* [attr* '()] . mathml*)
  `(msubsup ,attr* . ,mathml*))
(define (Msup #:attr* [attr* '()] . mathml*)
  `(msup ,attr* . ,mathml*))
(define (Mtable #:attr* [attr* '()] . mathml*)
  `(mtable ,attr* . ,mathml*))
(define (Mtd #:attr* [attr* '()] . mathml*)
  `(mtd ,attr* . ,mathml*))
(define (Mtext #:attr* [attr* '()] . mathml*)
  `(mtext ,attr* . ,mathml*))
(define (Mtr #:attr* [attr* '()] . mathml*)
  `(mtr ,attr* . ,mathml*))
(define (Munder #:attr* [attr* '()] . mathml*)
  `(munder ,attr* . ,mathml*))
(define (Munderover #:attr* [attr* '()] . mathml*)
  `(munderover ,attr* . ,mathml*))
(define (Maction #:attr* [attr* '()] . mathml*)
  `(maction ,attr* . ,mathml*))
(define (Menclose #:attr* [attr* '()] . mathml*)
  `(menclose ,attr* . ,mathml*))
(define (Mfenced #:attr* [attr* '()] . mathml*)
  `(mfenced ,attr* . ,mathml*))

第2.1.1小节 Some Useful Supplementary Definitions

There are also some useful supplementary definitions that deserve a place in this chapter.

(define (MathB #:attr* [attr* '()] . mathml*)
  `(math ((display "block") . ,attr*) . ,mathml*))
(define M Math)
(define MB MathB)
(define (MBL label . exp*)
  (MB (Mtable #:attr*
              '((columnalign "left center right")
                (displaystyle "true")
                (width "100%"))
              (Mtr (Mtd (Mphantom label))
                   (apply Mtd exp*)
                   (Mtd label)))))

(define $ (Mrow))
(define ^ Msup)
(define _ Msub)
(define _^ Msubsup)
(define __ Munder)
(define ^^ Mover)
(define __^^ Munderover)
(define ~ Mfrac)
(define % Mtext)

第2.2节 The HTML Part

The HTML part is just like the MathML part.

(define (A #:attr* [attr* '()] . html*)
  `(a ,attr* . ,html*))
(define (Abbr #:attr* [attr* '()] . html*)
  `(abbr ,attr* . ,html*))
(define (Address #:attr* [attr* '()] . html*)
  `(address ,attr* . ,html*))
(define (Area #:attr* [attr* '()] . html*)
  `(area ,attr* . ,html*))
(define (Article #:attr* [attr* '()] . html*)
  `(article ,attr* . ,html*))
(define (Aside #:attr* [attr* '()] . html*)
  `(aside ,attr* . ,html*))
(define (Audio #:attr* [attr* '()] . html*)
  `(audio ,attr* . ,html*))
(define (B #:attr* [attr* '()] . html*)
  `(b ,attr* . ,html*))
(define (Base #:attr* [attr* '()] . html*)
  `(base ,attr* . ,html*))
(define (Bdi #:attr* [attr* '()] . html*)
  `(bdi ,attr* . ,html*))
(define (Bdo #:attr* [attr* '()] . html*)
  `(bdo ,attr* . ,html*))
(define (Blockquote #:attr* [attr* '()] . html*)
  `(blockquote ,attr* . ,html*))
(define (Body #:attr* [attr* '()] . html*)
  `(body ,attr* . ,html*))
(define (Br #:attr* [attr* '()] . html*)
  `(br ,attr* . ,html*))
(define (Button #:attr* [attr* '()] . html*)
  `(button ,attr* . ,html*))
(define (Canvas #:attr* [attr* '()] . html*)
  `(canvas ,attr* . ,html*))
(define (Caption #:attr* [attr* '()] . html*)
  `(caption ,attr* . ,html*))
(define (Cite #:attr* [attr* '()] . html*)
  `(cite ,attr* . ,html*))
(define (Code #:attr* [attr* '()] . html*)
  `(code ,attr* . ,html*))
(define (Col #:attr* [attr* '()] . html*)
  `(col ,attr* . ,html*))
(define (Colgroup #:attr* [attr* '()] . html*)
  `(colgroup ,attr* . ,html*))
(define (Data #:attr* [attr* '()] . html*)
  `(data ,attr* . ,html*))
(define (Datalist #:attr* [attr* '()] . html*)
  `(datalist ,attr* . ,html*))
(define (Dd #:attr* [attr* '()] . html*)
  `(dd ,attr* . ,html*))
(define (Del #:attr* [attr* '()] . html*)
  `(del ,attr* . ,html*))
(define (Details #:attr* [attr* '()] . html*)
  `(details ,attr* . ,html*))
(define (Dfn #:attr* [attr* '()] . html*)
  `(dfn ,attr* . ,html*))
(define (Dialog #:attr* [attr* '()] . html*)
  `(dialog ,attr* . ,html*))
(define (Div #:attr* [attr* '()] . html*)
  `(div ,attr* . ,html*))
(define (Dl #:attr* [attr* '()] . html*)
  `(dl ,attr* . ,html*))
(define (Dt #:attr* [attr* '()] . html*)
  `(dt ,attr* . ,html*))
(define (Em #:attr* [attr* '()] . html*)
  `(em ,attr* . ,html*))
(define (Embed #:attr* [attr* '()] . html*)
  `(embed ,attr* . ,html*))
(define (Fieldset #:attr* [attr* '()] . html*)
  `(fieldset ,attr* . ,html*))
(define (Figcaption #:attr* [attr* '()] . html*)
  `(figcaption ,attr* . ,html*))
(define (Figure #:attr* [attr* '()] . html*)
  `(figure ,attr* . ,html*))
(define (Footer #:attr* [attr* '()] . html*)
  `(footer ,attr* . ,html*))
(define (Form #:attr* [attr* '()] . html*)
  `(form ,attr* . ,html*))
(define (H1 #:attr* [attr* '()] . html*)
  `(h1 ,attr* . ,html*))
(define (H2 #:attr* [attr* '()] . html*)
  `(h2 ,attr* . ,html*))
(define (H3 #:attr* [attr* '()] . html*)
  `(h3 ,attr* . ,html*))
(define (H4 #:attr* [attr* '()] . html*)
  `(h4 ,attr* . ,html*))
(define (H5 #:attr* [attr* '()] . html*)
  `(h5 ,attr* . ,html*))
(define (H6 #:attr* [attr* '()] . html*)
  `(h6 ,attr* . ,html*))
(define (Head #:attr* [attr* '()] . html*)
  `(head ,attr* . ,html*))
(define (Header #:attr* [attr* '()] . html*)
  `(header ,attr* . ,html*))
(define (Hgroup #:attr* [attr* '()] . html*)
  `(hgroup ,attr* . ,html*))
(define (Hr #:attr* [attr* '()] . html*)
  `(hr ,attr* . ,html*))
(define (Html #:attr* [attr* '()] . html*)
  `(html ,attr* . ,html*))
(define (I #:attr* [attr* '()] . html*)
  `(i ,attr* . ,html*))
(define (Iframe #:attr* [attr* '()] . html*)
  `(iframe ,attr* . ,html*))
(define (Img #:attr* [attr* '()] . html*)
  `(img ,attr* . ,html*))
(define (Input #:attr* [attr* '()] . html*)
  `(input ,attr* . ,html*))
(define (Ins #:attr* [attr* '()] . html*)
  `(ins ,attr* . ,html*))
(define (Kbd #:attr* [attr* '()] . html*)
  `(kbd ,attr* . ,html*))
(define (Label #:attr* [attr* '()] . html*)
  `(label ,attr* . ,html*))
(define (Legend #:attr* [attr* '()] . html*)
  `(legend ,attr* . ,html*))
(define (Li #:attr* [attr* '()] . html*)
  `(li ,attr* . ,html*))
(define (Link #:attr* [attr* '()] . html*)
  `(link ,attr* . ,html*))
(define (Main #:attr* [attr* '()] . html*)
  `(main ,attr* . ,html*))
(define (Map #:attr* [attr* '()] . html*)
  `(map ,attr* . ,html*))
(define (Mark #:attr* [attr* '()] . html*)
  `(mark ,attr* . ,html*))
(define (Menu #:attr* [attr* '()] . html*)
  `(menu ,attr* . ,html*))
(define (Meta #:attr* [attr* '()] . html*)
  `(meta ,attr* . ,html*))
(define (Meter #:attr* [attr* '()] . html*)
  `(meter ,attr* . ,html*))
(define (Nav #:attr* [attr* '()] . html*)
  `(nav ,attr* . ,html*))
(define (Noscript #:attr* [attr* '()] . html*)
  `(noscript ,attr* . ,html*))
(define (Object #:attr* [attr* '()] . html*)
  `(object ,attr* . ,html*))
(define (Ol #:attr* [attr* '()] . html*)
  `(ol ,attr* . ,html*))
(define (Optgroup #:attr* [attr* '()] . html*)
  `(optgroup ,attr* . ,html*))
(define (Option #:attr* [attr* '()] . html*)
  `(option ,attr* . ,html*))
(define (Output #:attr* [attr* '()] . html*)
  `(output ,attr* . ,html*))
(define (P #:attr* [attr* '()] . html*)
  `(p ,attr* . ,html*))
(define (Picture #:attr* [attr* '()] . html*)
  `(picture ,attr* . ,html*))
(define (Pre #:attr* [attr* '()] . html*)
  `(pre ,attr* . ,html*))
(define (Progress #:attr* [attr* '()] . html*)
  `(progress ,attr* . ,html*))
(define (Q #:attr* [attr* '()] . html*)
  `(q ,attr* . ,html*))
(define (Rp #:attr* [attr* '()] . html*)
  `(rp ,attr* . ,html*))
(define (Rt #:attr* [attr* '()] . html*)
  `(rt ,attr* . ,html*))
(define (Ruby #:attr* [attr* '()] . html*)
  `(ruby ,attr* . ,html*))
(define (S #:attr* [attr* '()] . html*)
  `(s ,attr* . ,html*))
(define (Samp #:attr* [attr* '()] . html*)
  `(samp ,attr* . ,html*))
(define (Script #:attr* [attr* '()] . html*)
  `(script ,attr* . ,html*))
(define (Search #:attr* [attr* '()] . html*)
  `(search ,attr* . ,html*))
(define (Section #:attr* [attr* '()] . html*)
  `(section ,attr* . ,html*))
(define (Select #:attr* [attr* '()] . html*)
  `(select ,attr* . ,html*))
(define (Slot #:attr* [attr* '()] . html*)
  `(slot ,attr* . ,html*))
(define (Small #:attr* [attr* '()] . html*)
  `(small ,attr* . ,html*))
(define (Source #:attr* [attr* '()] . html*)
  `(source ,attr* . ,html*))
(define (Span #:attr* [attr* '()] . html*)
  `(span ,attr* . ,html*))
(define (Strong #:attr* [attr* '()] . html*)
  `(strong ,attr* . ,html*))
(define (Style #:attr* [attr* '()] . html*)
  `(style ,attr* . ,html*))
(define (Sub #:attr* [attr* '()] . html*)
  `(sub ,attr* . ,html*))
(define (Summary #:attr* [attr* '()] . html*)
  `(summary ,attr* . ,html*))
(define (Sup #:attr* [attr* '()] . html*)
  `(sup ,attr* . ,html*))
(define (Table #:attr* [attr* '()] . html*)
  `(table ,attr* . ,html*))
(define (Tbody #:attr* [attr* '()] . html*)
  `(tbody ,attr* . ,html*))
(define (Td #:attr* [attr* '()] . html*)
  `(td ,attr* . ,html*))
(define (Template #:attr* [attr* '()] . html*)
  `(template ,attr* . ,html*))
(define (Textarea #:attr* [attr* '()] . html*)
  `(textarea ,attr* . ,html*))
(define (Tfoot #:attr* [attr* '()] . html*)
  `(tfoot ,attr* . ,html*))
(define (Th #:attr* [attr* '()] . html*)
  `(th ,attr* . ,html*))
(define (Thead #:attr* [attr* '()] . html*)
  `(thead ,attr* . ,html*))
(define (Time #:attr* [attr* '()] . html*)
  `(time ,attr* . ,html*))
(define (Title #:attr* [attr* '()] . html*)
  `(title ,attr* . ,html*))
(define (Tr #:attr* [attr* '()] . html*)
  `(tr ,attr* . ,html*))
(define (Track #:attr* [attr* '()] . html*)
  `(track ,attr* . ,html*))
(define (U #:attr* [attr* '()] . html*)
  `(u ,attr* . ,html*))
(define (Ul #:attr* [attr* '()] . html*)
  `(ul ,attr* . ,html*))
(define (Var #:attr* [attr* '()] . html*)
  `(var ,attr* . ,html*))
(define (Video #:attr* [attr* '()] . html*)
  `(video ,attr* . ,html*))
(define (Wbr #:attr* [attr* '()] . html*)
  `(wbr ,attr* . ,html*))

第2.2.1小节 Some Useful Supplementary Definitions

The HTML part likewise has some useful supplementary definitions.

(define (Prelude #:title [title "index"] #:css [css '()] . body*)
  (Html
   (apply
    Head
    (Meta #:attr* '((charset "utf-8")))
    (Title title)
    (map (lambda (stylesheet)
           (Link #:attr* `((href ,stylesheet) (rel "stylesheet"))))
         (if (string? css) (list css) css)))
   (apply Body body*)))

(define (CodeB . str*)
  (Pre (apply Code str*)))

第3章 Extended Basic Definitions

This chapter provides many definitions that, although not the most basic, are still quite important. That is why we call them extended basic definitions. Without them, many simple cases would become rather complicated.

第3.1节 The MathML Part

First we define the mathematical identifiers for the basic letters.

(define $a (Mi "a"))
(define $b (Mi "b"))
(define $c (Mi "c"))
(define $d (Mi "d"))
(define $e (Mi "e"))
(define $f (Mi "f"))
(define $g (Mi "g"))
(define $h (Mi "h"))
(define $i (Mi "i"))
(define $j (Mi "j"))
(define $k (Mi "k"))
(define $l (Mi "l"))
(define $m (Mi "m"))
(define $n (Mi "n"))
(define $o (Mi "o"))
(define $p (Mi "p"))
(define $q (Mi "q"))
(define $r (Mi "r"))
(define $s (Mi "s"))
(define $t (Mi "t"))
(define $u (Mi "u"))
(define $v (Mi "v"))
(define $w (Mi "w"))
(define $x (Mi "x"))
(define $y (Mi "y"))
(define $z (Mi "z"))
(define $A (Mi "A"))
(define $B (Mi "B"))
(define $C (Mi "C"))
(define $D (Mi "D"))
(define $E (Mi "E"))
(define $F (Mi "F"))
(define $G (Mi "G"))
(define $H (Mi "H"))
(define $I (Mi "I"))
(define $J (Mi "J"))
(define $K (Mi "K"))
(define $L (Mi "L"))
(define $M (Mi "M"))
(define $N (Mi "N"))
(define $O (Mi "O"))
(define $P (Mi "P"))
(define $Q (Mi "Q"))
(define $R (Mi "R"))
(define $S (Mi "S"))
(define $T (Mi "T"))
(define $U (Mi "U"))
(define $V (Mi "V"))
(define $W (Mi "W"))
(define $X (Mi "X"))
(define $Y (Mi "Y"))
(define $Z (Mi "Z"))
(define $aa (Mi "𝕒"))
(define $bb (Mi "𝕓"))
(define $cc (Mi "𝕔"))
(define $dd (Mi "𝕕"))
(define $ee (Mi "𝕖"))
(define $ff (Mi "𝕗"))
(define $gg (Mi "𝕘"))
(define $hh (Mi "𝕙"))
(define $ii (Mi "𝕚"))
(define $jj (Mi "𝕛"))
(define $kk (Mi "𝕜"))
(define $ll (Mi "𝕝"))
(define $mm (Mi "𝕞"))
(define $nn (Mi "𝕟"))
(define $oo (Mi "𝕠"))
(define $pp (Mi "𝕡"))
(define $qq (Mi "𝕢"))
(define $rr (Mi "𝕣"))
(define $ss (Mi "𝕤"))
(define $tt (Mi "𝕥"))
(define $uu (Mi "𝕦"))
(define $vv (Mi "𝕧"))
(define $ww (Mi "𝕨"))
(define $xx (Mi "𝕩"))
(define $yy (Mi "𝕪"))
(define $zz (Mi "𝕫"))
(define $AA (Mi "𝔸"))
(define $BB (Mi "𝔹"))
(define $CC (Mi "ℂ"))
(define $DD (Mi "𝔻"))
(define $EE (Mi "𝔼"))
(define $FF (Mi "𝔽"))
(define $GG (Mi "𝔾"))
(define $HH (Mi "ℍ"))
(define $II (Mi "𝕀"))
(define $JJ (Mi "𝕁"))
(define $KK (Mi "𝕂"))
(define $LL (Mi "𝕃"))
(define $MM (Mi "𝕄"))
(define $NN (Mi "ℕ"))
(define $OO (Mi "𝕆"))
(define $PP (Mi "ℙ"))
(define $QQ (Mi "ℚ"))
(define $RR (Mi "ℝ"))
(define $SS (Mi "𝕊"))
(define $TT (Mi "𝕋"))
(define $UU (Mi "𝕌"))
(define $VV (Mi "𝕍"))
(define $WW (Mi "𝕎"))
(define $XX (Mi "𝕏"))
(define $YY (Mi "𝕐"))
(define $ZZ (Mi "ℤ"))

For Greek letters we also have a complete set of definitions.

(define $alpha (Mi "α"))
(define $beta (Mi "β"))
(define $gamma (Mi "γ"))
(define $delta (Mi "δ"))
(define $epsilon (Mi "ε"))
(define $zeta (Mi "ζ"))
(define $eta (Mi "η"))
(define $theta (Mi "θ"))
(define $iota (Mi "ι"))
(define $kappa (Mi "κ"))
(define $lambda (Mi "λ"))
(define $mu (Mi "μ"))
(define $nu (Mi "ν"))
(define $xi (Mi "ξ"))
(define $omicron (Mi "ο"))
(define $pi (Mi "π"))
(define $rho (Mi "ρ"))
(define $sigma (Mi "σ"))
(define $tau (Mi "τ"))
(define $upsilon (Mi "υ"))
(define $phi (Mi "φ"))
(define $chi (Mi "χ"))
(define $psi (Mi "ψ"))
(define $omega (Mi "ω"))
(define $Alpha (Mi "Α"))
(define $Beta (Mi "Β"))
(define $Gamma (Mi "Γ"))
(define $Delta (Mi "Δ"))
(define $Epsilon (Mi "Ε"))
(define $Zeta (Mi "Ζ"))
(define $Eta (Mi "Η"))
(define $Theta (Mi "Θ"))
(define $Iota (Mi "Ι"))
(define $Kappa (Mi "Κ"))
(define $Lambda (Mi "Λ"))
(define $Mu (Mi "Μ"))
(define $Nu (Mi "Ν"))
(define $Xi (Mi "Ξ"))
(define $Omicron (Mi "Ο"))
(define $Pi (Mi "Π"))
(define $Rho (Mi "Ρ"))
(define $Sigma (Mi "Σ"))
(define $Tau (Mi "Τ"))
(define $Upsilon (Mi "Υ"))
(define $Phi (Mi "Φ"))
(define $Chi (Mi "Χ"))
(define $Psi (Mi "Ψ"))
(define $Omega (Mi "Ω"))

For numbers, we only define $0$ through $9$.

(define $0 (Mn "0"))
(define $1 (Mn "1"))
(define $2 (Mn "2"))
(define $3 (Mn "3"))
(define $4 (Mn "4"))
(define $5 (Mn "5"))
(define $6 (Mn "6"))
(define $7 (Mn "7"))
(define $8 (Mn "8"))
(define $9 (Mn "9"))

第3.2节 The HTML Part

The HTML part also has some extended basic definitions, though not many. Moreover, many of them perhaps do not belong here.

(define (make-table #:attr* [attr* '()] lst)
  (keyword-apply
   Table '(#:attr*) (list attr*)
   (map (lambda (row)
          (apply Tr (map Td row)))
        lst)))

(define (map2 proc lst)
  (cond ((null? lst) '())
        ((null? (cdr lst)) (list (proc (car lst))))
        (else (cons (proc (car lst) (cadr lst))
                    (map2 proc (cddr lst))))))

(define (columnize . xml*)
  (make-table
   #:attr* '((width "100%"))
   (map2 list xml*)))

(define -- "——")

(define (enum . x*)
  (apply Span (add-between x* ", ")))

第4章 Practical Definitions

Starting with this chapter, we present a number of practical definitions. Some of them serve as basic tools, which users are free to use as well. Others are built on top of these tools.

第4.1节 Operators and Infix Operators

Operators are one of the basic ingredients of mathematical notation, so we provide a number of convenient tools along with definitions of many common operators.

(define ((make-op op n u) . x*)
  (cond
    ((null? x*) (n))
    ((null? (cdr x*)) (u (car x*)))
    (else
     (let iter ((x (car x*)) (x* (cdr x*)) (r '()))
       (if (null? x*)
           (apply Mrow (reverse (cons x r)))
           (iter (car x*)
                 (cdr x*)
                 (cons op (cons x r))))))))
(define (err0 id)
  (lambda ()
    (error id "")))
(define (err1 id)
  (lambda (x)
    (error id "~s" x)))

(define (make-infix op id)
  (make-op op
    (err0 id)
    (err1 id)))
(define-syntax define-infix*
  (syntax-rules ()
    ((_ (id op) ...)
     (begin
       (define id (make-infix op 'id))
       ...))))

Let us look at some examples to see how these tools are used.

(define &cm
  (make-op $cm
    (lambda () $)
    (lambda (x) x)))

(define $cm (Mo ","))

Here is another example.

(define &-
  (make-op $-
    (err0 '&-)
    (lambda (x) (Mrow $- x))))

(define $-1 (&- $1))
(define $-2 (&- $2))
(define $-3 (&- $3))
(define $-4 (&- $4))
(define $-5 (&- $5))
(define $-6 (&- $6))
(define $-7 (&- $7))
(define $-8 (&- $8))
(define $-9 (&- $9))

第4.2节 Big Operators

There is another special kind of operator that we use often, which might be called big operators.

(define (make-bigop op)
  (case-lambda
    ((u o e) (Mrow (Munderover op u o) e))
    ((u e) (Mrow (Munder op u) e))
    ((e) (Mrow op e))))
(define-syntax define-bigop*
  (syntax-rules ()
    ((_ (id op) ...)
     (begin
       (define id (make-bigop op))
       ...))))

A big operator procedure always accepts one, two or three arguments. With one argument, the big operator has no limits above or below it. With two, it has only a lower limit. With three, it has both. This matches exactly how big operators are customarily used. Note, however, that the limits of a big operator are rendered differently in inline mode and in block mode, which is in fact much the same as in LaTeX. In inline mode the limits become sub- and superscripts, while in block mode they really do appear above and below the operator. To get the block-mode style in inline mode, set the displaystyle attribute to true.

(define-bigop*
  (sum $sum)
  (prod $prod)
  (Union $Union)
  (Cup $Union)
  (Intersect $Cap)
  (Cap $Cap)
  (Disj $Disj)
  (Conj $Conj))

第4.3节 Bracketing Procedures and List Enumeration Procedures

Brackets and list-style enumerations are among the most common mathematical expressions, so it is worth providing all the usual variants.

First, though, let us look at a few constant definitions.

(define $lp (Mo "("))
(define $rp (Mo ")"))
(define $lp0
  (Mo "(" #:attr* '((stretchy "false"))))
(define $rp0
  (Mo ")" #:attr* '((stretchy "false"))))

(define (pare x)
  (Mrow $lp x $rp))
(define (par0 x)
  (Mrow $lp0 x $rp0))

With the bracketing procedures in place, we can define the accompanying list enumeration procedures.

(define (tup . x*)
  (pare (apply &cm x*)))
(define (tu0 . x*)
  (par0 (apply &cm x*)))

The above uses only parentheses. For square brackets, curly braces, angle brackets, vertical bars and double vertical bars, we have similar definitions.

(define $lb (Mo "["))
(define $rb (Mo "]"))
(define $lb0
  (Mo "[" #:attr* '((stretchy "false"))))
(define $rb0
  (Mo "]" #:attr* '((stretchy "false"))))
(define $lc (Mo "{"))
(define $rc (Mo "}"))
(define $lc0
  (Mo "{" #:attr* '((stretchy "false"))))
(define $rc0
  (Mo "}" #:attr* '((stretchy "false"))))
(define $lv (Mo "|"))
(define $rv (Mo "|"))
(define $lv0
  (Mo "|" #:attr* '((stretchy "false"))))
(define $rv0
  (Mo "|" #:attr* '((stretchy "false"))))
(define $la (Mo "⟨"))
(define $ra (Mo "⟩"))
(define $la0
  (Mo "⟨" #:attr* '((stretchy "false"))))
(define $ra0
  (Mo "⟩" #:attr* '((stretchy "false"))))
(define $ld (Mo "‖"))
(define $rd (Mo "‖"))
(define $ld0
  (Mo "‖" #:attr* '((stretchy "false"))))
(define $rd0
  (Mo "‖" #:attr* '((stretchy "false"))))

(define (brac x)
  (Mrow $lb x $rb))
(define (bra0 x)
  (Mrow $lb0 x $rb0))
(define (curb x)
  (Mrow $lc x $rc))
(define (cur0 x)
  (Mrow $lc0 x $rc0))
(define (vert x)
  (Mrow $lv x $rv))
(define (ver0 x)
  (Mrow $lv0 x $rv0))
(define (angb x)
  (Mrow $la x $ra))
(define (ang0 x)
  (Mrow $la0 x $ra0))
(define (dver x)
  (Mrow $ld x $rd))
(define (dve0 x)
  (Mrow $ld0 x $rd0))

(define (lis . x*)
  (brac (apply &cm x*)))
(define (li0 . x*)
  (bra0 (apply &cm x*)))
(define (enu . x*)
  (curb (apply &cm x*)))
(define (en0 . x*)
  (cur0 (apply &cm x*)))
(define (tupan . x*)
  (angb (apply &cm x*)))
(define (tupa0 . x*)
  (ang0 (apply &cm x*)))

Later, when writing about denotational semantics, I often needed double square brackets, which led to the following definitions.

(define $ldb (Mo "⟦"))
(define $rdb (Mo "⟧"))
(define (&db x)
  (Mrow $ldb x $rdb))
(define $ldb0 (Mo "⟦" #:attr* '((stretchy "false"))))
(define $rdb0 (Mo "⟧" #:attr* '((stretchy "false"))))
(define (&db0 x)
  (Mrow $ldb0 x $rdb0))

We also have some definitions for set-builder notation, and this section seems a fitting place for them.

(define setE en0)
(define (setI a b)
  (cur0 (Mrow a $lv0 b)))
(define (setEnum a b)
  (setE a $..h b))

第4.4节 Parenthesization

We often need to put parentheses around an expression, so SMathML provides a parenthesizing procedure that turns an ordinary notation procedure into a parenthesized version.

(define (@ . x*)
  (par0 (apply : x*)))
(define (@lize &) (compose @ &))
(define-syntax define-@lized-op*
  (syntax-rules ()
    ((_ (id op) ...)
     (begin
       (define id (@lize op))
       ...))))

(define (: . x*)
  (cond
    ((null? x*) $)
    ((null? (cdr x*)) (car x*))
    (else (apply Mrow x*))))

(define-@lized-op*
  (@+ &+)
  (@- &-)
  (@* &*)
  (@i* &i*)
  (@c* &c*)
  (@d* &d*)
  (@t* &t*)
  (@w* &w*)
  (@compose &compose)
  (@conj &conj)
  (@disj &disj)
  (@sqcup &sqcup)
  (@sqcap &sqcap)
  (@: &:)
  (@neg &neg)
  (@-> &->)
  (@=> &=>)
  (@= &=)
  (@ap ap)
  (@cong &cong)
  (@~ &~)
  (@sqsube &sqsube)
  (@rarr &rarr)
  (@larr &larr)
  (@uarr &uarr)
  (@darr &darr)
  (@rArr &rArr)
  (@lArr &lArr)
  (@uArr &uArr)
  (@dArr &dArr))

第4.5节 Function Application

Standard prefix function application is one of the most frequently used notations in mathematics, so we provide the following procedures.

(define $af (Mo "⁡"))
(define (ap f x)
  (Mrow f $af x))
(define (app f . x*)
  (ap f (apply @ x*)))
(define app*
  (case-lambda
    ((f x) (app f x))
    ((f g . arg*) (app f (apply app* g arg*)))))
(define (appl f . x*)
  (ap f (apply tu0 x*)))

We also provide @ap, the parenthesized version of ap.

第4.6节 Table Procedures

MathML tables resemble HTML tables in some respects, but they retain many traditional table attributes. These attributes are already deprecated for HTML tables, and Chrome has no support at all for them on MathML tables. Firefox, at least, does support them. So far I have only considered how things render in Firefox; for compatibility, this should perhaps be changed to suit other browsers. Chrome recommends that MathML users control MathML tables with CSS.

I think the details of this part are written terribly, to an appalling degree. Even so, I have lately had no energy to rework them. These procedures and macros are still worth using. Tables are very flexible: ordinary arrangements, case distinctions, matrices and determinants can all be expressed with them.

(define (&table l)
  (apply Mtable
         (map (lambda (r)
                (apply Mtr (map Mtd r)))
              l)))
(define-syntax &Table
  (syntax-rules ()
    ((_ (x ...) ...)
     (&table (list (list x ...) ...)))))
(define (choice l)
  (Mrow $lc (&table l)))
(define-syntax Choice
  (syntax-rules ()
    ((_ (x ...) ...)
     (choice (list (list x ...) ...)))))
(define (choice0 l)
  (Mrow
   $lc
   (keyword-apply
    Mtable
    '(#:attr*) '(((displaystyle "true")))
    (map (lambda (r)
           (Mtr (Mtd (car r))
                (keyword-apply
                 Mtd '(#:attr*) '(((columnalign "left")))
                 (cdr r))))
         l))))
(define-syntax Choice0
  (syntax-rules ()
    ((_ (x ...) ...)
     (choice0 (list (list x ...) ...)))))
(define (mat l)
  (brac (&table l)))
(define-syntax Mat
  (syntax-rules ()
    ((_ (x ...) ...)
     (mat (list (list x ...) ...)))))
(define (ma0 l)
  (pare (&table l)))
(define-syntax Ma0
  (syntax-rules ()
    ((_ (x ...) ...)
     (ma0 (list (list x ...) ...)))))
(define (det l)
  (vert (&table l)))
(define-syntax Det
  (syntax-rules ()
    ((_ (x ...) ...)
     (det (list (list x ...) ...)))))

第4.7节 Primes and Double Primes

SMathML provides procedures for primes and double primes, which are often used to denote derivatives or simply different names.

(define $prime (Mo "′"))
(define $Prime (Mo "″"))
(define (&prime x)
  (Msup x $prime))
(define (&Prime x)
  (Msup x $Prime))
(define (_prime x i)
  (_^ x i $prime))
(define (_Prime x i)
  (_^ x i $Prime))

第4.8节 Combinations of Constants

Constants combined via ^ and _ appear frequently in mathematics, so for users' convenience we have a large number of predefined combinations. These, too, were generated automatically.

Primed versions of the constants, i.e. the results of applying &prime, are also used often. Our naming convention is to append ^. Double-primed versions should really be added too, but we left them out; their naming convention would be to append ^^.

We provide all the mathvariant variants of every letter. The naming convention is to append : followed by the name of the variant, for example: $$\begin{array}{|cl|}\hline \mathrm{P}& ''\$P:normal''\\ \mathbf{P}& ''\$P:bold''\\ \mathit{P}& ''\$P:italic''\\ \mathit{P}& ''\$P:bold-italic''\\ \mathcal{P}& ''\$P:script''\\ \mathcal{P}& ''\$P:bold-script''\\ \mathfrak{P}& ''\$P:fraktur''\\ \mathfrak{P}& ''\$P:bold-fraktur''\\ \mathsf{P}& ''\$P:sans-serif''\\ \mathsf{P}& ''\$P:bold-sans-serif''\\ \mathsf{P}& ''\$P:sans-serif-italic''\\ \mathsf{P}& ''\$P:sans-serif-bold-italic''\\ \mathbb{P}& ''\$P:double-struck''\\ \mathtt{P}& ''\$P:monospace''\\ \hline\end{array}$$ Readers should note that Chrome's MathML Core does not support mathvariant at all.

第4.9节 Entries

Mathematical literature is full of entries of various kinds: axioms, definitions, propositions, theorems, lemmas, corollaries and so on. It is therefore worth providing a tool for them, along with some predefined entry procedures.

(define (entry-make class template)
  (lambda (#:n [n ""])
    (lambda x*
      (keyword-apply
       Div '(#:attr*) `(((class ,class)))
       (B (format template n) " ") x*))))
(define-syntax-rule
  (define-entry* (id class template) ...)
  (begin
    (define id (entry-make class template))
    ...))

For now we provide the following predefined entries.

(define-entry*
  (definition "definition" "定义~a.")
  (lemma "lemma" "引理~a.")
  (theorem "theorem" "定理~a.")
  (corollary "corollary" "推论~a.")
  (example "example" "例子~a.")
  (notation "notation" "记号~a.")
  (comment "comment" "注记~a.")
  (program "program" "程序~a.")
  (exercise "exercise" "练习~a.")
  (proposition "proposition" "命题~a.")
  (remark "remark" "评注~a.")
  (convention "convention" "约定~a.")
  (tcomment "tcomment" "译者注记~a.")
  (answer "answer" "解答~a."))

第4.10节 Abstractions over Laws and Axioms

Part of SMathML's flexibility lies in its ability to express many higher-order abstractions. One direct application is expressing laws and axioms, such as commutativity and associativity. The current definitions are not polished enough, and readers are generally advised to define their own as needed; what follows is only meant to get the ball rolling.

(define (commute* a b)
  (&= (&i* a b) (&i* b a)))
(define (commute+ a b)
  (&= (&+ a b) (&+ b a)))
(define (commute & a b)
  (&= (& a b) (& b a)))

(define (assoc* a b c)
  (&= (&i* a (@ (&i* b c)))
      (&i* (@ (&i* a b)) c)))
(define (assoc+ a b c)
  (&= (&+ a (@ (&+ b c)))
      (&+ (@ (&+ a b)) c)))
(define (associate & a b c)
  (&= (& (@ (& a b)) c) (& a (@ (& b c)))))

(define (disL a b c)
  (&= (&i* (@ (&+ a b)) c)
      (&+ (&i* a c)
          (&i* b c))))
(define (disR a b c)
  (&= (&i* a (@ (&+ b c)))
      (&+ (&i* a b)
          (&i* a c))))
(define (distributeL a + b * c)
  (&= (* (@ (+ a b)) c)
      (+ (@ (* a c)) (@ (* b c)))))
(define (distributeR a * b + c)
  (&= (* a (@ (+ b c)))
      (+ (@ (* a b)) (@ (* a c)))))

There is one more procedure that, although not yet part of SMathML, may be worth a look:

(define (!commute f g . x*)
  (&= (f (apply g x*))
      (apply g (map f x*))))

(MB (!commute (curry app $F)
              &compose
              $f $g))

第4.11节 Derivations

Derivations are actually implemented with tables as well, but the author preferred to give them a section of their own.

(define (make-row . x*)
  (apply Mtr (map Mtd x*)))
(define (deriv x y . z*)
  (keyword-apply
   Mtable
   '(#:attr*) '(((displaystyle "true") (columnalign "right center left")))
   (cons (make-row x $= y)
         (map (lambda (z) (make-row $ $= z)) z*))))
(define (deriv0 x -> y . z*)
  (keyword-apply
   Mtable
   '(#:attr*) '(((displaystyle "true") (columnalign "right center left")))
   (cons (make-row x -> y)
         (map2 (lambda (-> w) (make-row $ -> w)) z*))))

Building on set-attr*, introduced later, SMathML also provides some derived procedures.

(define-syntax-rule (eqn* (x ...) ...)
  (MB (set-attr*
       (&Table (x ...) ...)
       'columnalign "right center left"
       'displaystyle "true")))

(define (deriv^ x . y*)
  (set-attr*
   (apply
    Mtable
    (Mtr (Mtd $) (Mtd x))
    (map (lambda (y)
           (Mtr (Mtd $=) (Mtd y)))
         y*))
   'displaystyle "true"
   'columnalign "center left"))
(define (deriv^0 x . y*)
  (set-attr*
   (apply
    Mtable
    (Mtr (Mtd $) (Mtd x))
    (map2 (lambda (= y)
            (Mtr (Mtd =) (Mtd y)))
          y*))
   'displaystyle "true"
   'columnalign "center left"))

第4.12节 Spacing

We often need to list some mathematical expressions with a certain spacing, so SMathML provides procedures for that too.

(define (&space n)
  (Mspace #:attr* `((width ,(format "~sex" n)))))
(define (&split n)
  (make-op (&space n)
    (lambda () $)
    (lambda (x) x)))

第4.13节 Arrows

Arrows of all kinds are also used constantly in mathematics; see the following table: Here -> is effectively an alias for rarr, <-> for harr, => for rArr, <=> for hArr, and so on.

第4.14节 Ellipses

SMathML provides several common ellipsis constants. $$\begin{array}{|cl|}\hline \dots & ''\$..h''\\ \cdots & ''\$..c''\\ ⋮& ''\$..v''\\ ⋰& ''\$..u''\\ \ddots & ''\$..d''\\ \hline\end{array}$$

第4.15节 Overlines and Underlines

SMathML provides procedures for overlines and underlines. In the future, procedures for underbraces and the like should perhaps be added as well.

(define $OverBar (Mo "‾"))
(define (OverBar x)
  (^^ x $OverBar))
(define $UnderBar (Mo "_"))
(define (UnderBar x)
  (__ x $UnderBar))

第4.16节 Function Notation

SMathML provides some common notations related to functions.

(define (func f A B)
  (&: f (&-> A B)))

(define $\|-> (Mo "↦"))

(define (func:def f A B x fx)
  (&: f (&cm (&-> A B) (&\|-> x fx))))

第4.17节 Limit Notation

Limit notation is used all the time in analysis.

(define $lim (Mi "lim"))
(define lim
  (case-lambda
    ((p f) (: (__ $lim p) f))
    ((x a f) (: (__ $lim (&->0 x a)) f))))

第4.18节 Inference Rules

Logic and programming languages often call for typesetting inference rules and proof trees. SMathML's support for this is based entirely on Mfrac; the result is not especially pleasing to the eye, but at least it is readable.

(define (&rule #:space [n 8] . j*)
  (let-values (((j* j1) (split-at-right j* 1)))
    (if (null? j*)
        (car j1)
        (~ #:attr* '((displaystyle "true"))
           (apply (&split n) j*) (car j1)))))

(define (&rule* j . j*)
  (if (null? j*)
      j
      (apply &rule*
             (~ #:attr* '((displaystyle "true"))
                j (car j*))
             (cdr j*))))

第5章 Transformations

Transformations are the core of SMathML; without them many abstractions would be hard to express.

第5.1节 The General Transformation T

Let us start with the code of T.

(define (T style*)
  (define default-handler
    (let ((default-binding (assoc '(default) style*)))
      (match default-binding
        (`((default) *preorder* ,handler) handler)
        (`((default) ,handler)
         (lambda (tag attr* . xml*)
           (apply handler tag attr* (map transform xml*))))
        (else
         (lambda (tag attr* . xml*)
           `(,tag ,attr* . ,(map transform xml*)))))))
  (define text-handler
    (let ((text-binding (assoc '(text) style*)))
      (if text-binding
          (cadr text-binding)
          identity)))
  (define Style*
    (map
     (lambda (binding)
       (match binding
         (`(,tag *preorder* ,handler)
          (cons tag handler))
         (`(,tag ,handler)
          (cons tag
                (lambda (tag attr* . xml*)
                  (apply handler tag attr*
                         (map transform xml*)))))))
     (filter (lambda (style) (symbol? (car style)))
             style*)))
  (define (transform xml)
    (match xml
      (`(,tag ,attr* . ,xml*)
       (let ((binding (assq tag Style*)))
         (if binding
             (apply (cdr binding) tag attr* xml*)
             (apply default-handler tag attr* xml*))))
      (str (text-handler str))))
  transform)

;<xml> ::= <string> | <symbol> | <number> | <boolean> | <vector>
;       |  (<tag> (<attr>*) <xml>*)
;<tag> ::= <symbol> | <a scheme value other than symbol>
;<attr> ::= (<symbol> <string>)
;<binding> ::= (<symbol> <handler>)
;           |  (<symbol> *preorder* <handler>)
;           |  ((default) <handler>)
;           |  ((default) *preorder* <handler>)
;           |  ((text) <text-handler>)
;<handler> : <symbol> * <attr>* * <xml>* -> <xml>
;<text-handler> : <string> -> <string>

The current design of T has one awkward point: it provides no syntax for handling several possible symbols in the same way. There are various workarounds, however, so it is not that this cannot be expressed. This should be changed in the future.

第5.2节 Modifying Attributes

SMathML provides two procedures for modifying attributes: attr*-set and set-attr*. In fact, set-attr* is built on attr*-set.

(define (attr*-set attr* . xv*)
  (define (s a* x v)
    (if (eq? v #f)
        a*
        (let s ((a* a*) (x x) (v v))
          (cond ((null? a*)
                 (list (list x v)))
                ((eq? (caar a*) x)
                 (cons (list x v) (cdr a*)))
                (else
                 (cons (car a*)
                       (s (cdr a*) x v)))))))
  (if (null? xv*)
      attr*
      (let iter ((x (car xv*))
                 (v (cadr xv*))
                 (xv* (cddr xv*))
                 (a* attr*))
        (if (null? xv*)
            (s a* x v)
            (iter (car xv*) (cadr xv*) (cddr xv*)
                  (s a* x v))))))

(define (set-attr* xml . xv*)
  (match xml
    (`(,tag ,attr* . ,xml*)
     `(,tag ,(apply attr*-set attr* xv*) . ,xml*))
    ((? string? str)
     `(div ,(apply attr*-set '() xv*) ,str))))

第5.3节 Tm: An Auxiliary Transformation for Mathematical Content

Tm is a core transformation procedure; almost every page of the author's blog uses Tm. In fact, whenever a page contains mathematical content, it should use Tm; this is the recommended practice.

Tm fixes some of the awkwardness of using SMathML. For example, without Tm, even a MathML element meant to be inline would have to be wrapped in Math or M, which is clearly unreasonable. Merely adding Math is easy to automate: one only needs to detect MathML elements left bare. But expressions already wrapped in a MathML root element must be left alone, and so must their attributes; otherwise, for instance, switching between inline and block mode would break. Tm also smooths over some other awkward points. For example, using text inside MathML used to require adding Mtext by hand, which Tm now automates completely. Tm also transforms some other constants that would otherwise be invalid, for example wrapping integers in Mn. Moreover, for a bare integer, Tm does not forget to add Math. Symbols and fractions are also handled by Tm as intuitively as possible.

Here is our implementation of Tm.

(define (Mid id) (Mi (symbol->string id)))
(define (Mnum n) (Mn (number->string n)))
(define (Mint n)
  (if (< n 0)
      (&- (Mnum (- n)))
      (Mnum n)))
(define (Mrat n)
  (let* ((a (numerator n))
         (b (denominator n)))
    (if (< a 0)
        (&- (~ (Mnum (- a)) (Mnum b)))
        (~ (Mnum a) (Mnum b)))))
(define mathml-tag*
  (list->seteq
   '(merror
     mfrac mi mmultiscripts mn mo mover
     mpadded mphantom mroot mrow
     ms mspace msqrt mstyle msub msubsup
     msup mtable mtd mtext mtr munder
     munderover maction menclose mfenced
     #;mprescripts)))
(define math-style*
  `(((default)
     *preorder*
     ,(lambda (tag attr* . xml*)
        (cond ((eq? tag 'math) `(,tag ,attr* . ,(map Tx xml*)))
              ((set-member? mathml-tag* tag)
               (Math (Tx `(,tag ,attr* . ,xml*))))
              (else `(,tag ,attr* . ,(map Tm xml*))))))
    ((text) ,(lambda (text)
               (cond ((string? text) text)
                     ((symbol? text) (Math (Mid text)))
                     ((integer? text) (Math (Mint text)))
                     ((rational? text) (Math (Mrat text)))
                     (else (error 'Tm "unknown element ~s" text)))))
    ))
;token elements: mtext mi mn mo mspace ms
(define token-tag*
  (seteq 'mtext 'mi 'mn 'mo 'mspace 'ms))
(define mtext-style*
  `(((default)
     *preorder*
     ,(lambda (tag attr* . xml*)
        (cond ((memq tag '(mi mn mo ms mspace mtext))
               `(,tag ,attr* . ,xml*))
              (else `(,tag ,attr* . ,(map Tx xml*))))))
    ((text) ,(lambda (text)
               (cond ((string? text) (% text))
                     ((symbol? text) (Mid text))
                     ((integer? text) (Mint text))
                     ((rational? text) (Mrat text))
                     (else (error 'Tm "unknown element ~s" text)))))))
(define Tm (T math-style*))
(define Tx (T mtext-style*))

Based on Tm, we define TmPrelude as a straightforward composition.

(define TmPrelude
  (compose Tm Prelude))

第5.3.1小节 The Refactored Version

Recently the author refactored Tm so that it no longer uses T, which should lower the cognitive load of fully understanding it.

(define (Tm xml)
  (define (wrap text)
    (cond
      ((symbol? text) (Mid text))
      ((integer? text) (Mint text))
      ((rational? text) (Mrat text))
      (else (error 'Tm "unknown element ~s" text))))
  (define (G xml)
    (match xml
      (`(,tag ,attr* . ,xml*)
       (cond ((eq? tag 'math)
              `(,tag ,attr* . ,(map M xml*)))
             ((set-member? mathml-tag* tag)
              (Math (M xml)))
             (else
              `(,tag ,attr* . ,(map G xml*)))))
      (text
       (if (string? text)
           text
           (Math (wrap text))))))
  (define (M xml)
    (match xml
      (`(,tag ,attr* . ,xml*)
       (if (memq tag '(mi mn mo ms mspace mtext))
           xml
           `(,tag ,attr* . ,(map M xml*))))
      (text
       (if (string? text)
           (Mtext text)
           (wrap text)))))
  (G xml))

第5.4节 Table Transformation

In the early days of using SMathML, the author felt the need for a position-sensitive table transformation. Now, however, the author thinks it is better to do the transformation while constructing the table.

(define (mapi f l)
  (let m ((i 0) (l l))
    (if (null? l)
        '()
        (cons (f (car l) i)
              (m (+ i 1) (cdr l))))))
(define (Ttable Td)
  (define (Tt tag attr* . r*)
    `(mtable ,attr* . ,(mapi Tr r*)))
  (define (Tr r i)
    (apply
     (lambda (tag attr* . d*)
       `(mtr ,attr* .
             ,(mapi (lambda (d j) (Td d i j)) d*)))
     r))
  (T `((mtable *preorder* ,Tt))))

第6章 Automatic Numbering and Cross-References

Automatic numbering and cross-referencing are essential in practice. SMathML now has preliminary support for them, though it is rather cumbersome to use.

The rough idea is as follows. We use special vector tags whose fields are, naturally, mutable. First we accumulate information in a linear traversal, constructing the corresponding headings and entries, together with their citation forms, along the way. We also build an association list from strings to citation forms. Then a second traversal replaces references made by strings with the corresponding citation forms.

This mechanism is not elegant, but at least it is serviceable; it will quite likely be rewritten substantially in the future.

第6.1节 Implementation

(define (pass0 exp)
  (define citation-table '())
  (define (extend-table! id citation)
    (if (assoc id citation-table)
        (error 'automatic-numbering-pass0 "id conflict!")
        (set! citation-table
              (cons (cons id citation) citation-table))))
  (let iterate ((henv '(0)) (section #f) (genv '()) (lenv '()) (rest exp) (result '()))
    (if (null? rest)
        (cons citation-table (reverse result))
        (let ((current (car rest)) (rest (cdr rest)))
          (match current
            ((,tag ,attr* . ,xml*)
             (cond
               ((symbol? tag)
                (iterate henv section genv lenv rest (cons current result)))
               ((%heading? tag)
                (define level (%heading-level tag))
                (define id (%heading-id tag))
                (define auto? (%heading-auto? tag))
                (define present (%heading-present tag))
                (define cite (%heading-cite tag))
                (define switch? (%heading-switch? tag))
                (cond (auto? (define section (henv-next henv level))
                             (set-%heading-section! tag section)
                             (when id (extend-table! id (cite tag)))
                             (iterate section section genv
                                      (if switch? '() lenv) rest
                                      (cons (apply present tag attr* xml*) result)))
                      (else (define section (henv-* henv level))
                            (set-%heading-section! tag section)
                            (when id (extend-table! id (cite tag)))
                            (iterate henv section genv
                                     (if switch? '() lenv) rest
                                     (cons (apply present tag attr* xml*) result)))))
               ((%entry? tag)
                (define local? (%entry-local? tag))
                (define class (%entry-class tag))
                (define id (%entry-id tag))
                (define auto? (%entry-auto? tag))
                (define present (%entry-present tag))
                (define cite (%entry-cite tag))
                (set-%entry-section! tag section)
                (cond (auto? (let-values (((g/lenv nval)
                                           (g/lenv-next (if local? lenv genv) class)))
                               (set-%entry-index! tag nval)
                               (when id (extend-table! id (cite tag)))
                               (if local?
                                   (iterate henv section genv g/lenv rest
                                            (cons (apply present tag attr* xml*) result))
                                   (iterate henv section g/lenv lenv rest
                                            (cons (apply present tag attr* xml*)
                                                  result)))))
                      (else (when id (extend-table! id (cite tag)))
                            (iterate henv section genv lenv rest
                                     (cons (apply present tag attr* xml*) result)))))
               (else
                (iterate henv section genv lenv rest (cons current result)))))
            (,else (iterate henv section genv lenv rest (cons current result))))))))

(define (make-compatible henv level)
  (define len (length henv))
  (define (aux henv i)
    (if (= i level)
        henv
        (aux (cons 0 henv) (add1 i))))
  (cond ((= len level) henv)
        ((> len level) (take-right henv level))
        (else (aux henv len))))
(define (henv-inc henv)
  (cons (add1 (car henv)) (cdr henv)))
(define (henv-next henv level)
  (henv-inc (make-compatible henv level)))
(define (henv-* henv level)
  (define comp (make-compatible henv level))
  (cons '* (cdr comp)))
(define (extend-g/lenv class index g/lenv)
  (cons (cons class (box index)) g/lenv))
(define (g/lenv-next g/lenv class)
  (define binding (assoc class g/lenv))
  (if binding
      (let* ((box0 (cdr binding))
             (nval (add1 (unbox box0))))
        (set-box! box0 nval)
        (values g/lenv nval))
      (values (extend-g/lenv class 1 g/lenv) 1)))

;pass1
(define (Ref id) `(ref () ,id))
(define (pass1 exp)
  (define citation-table (car exp))
  (define (reify id)
    (cond ((assoc id citation-table) => cdr)
          (else (error 'pass1 "unknown id ~s" id))))
  (define Tr
    (T `((ref *preorder* ,(lambda (ref empty id) (reify id))))))
  (define xml* (cdr exp))
  (map Tr xml*))

;automatic numbering
(define numbering-style*
  `((body
     *preorder*
     ,(lambda (tag attr* . xml*)
        `(,tag ,attr* . ,(pass1 (pass0 xml*)))))))
(define Tn
  (T numbering-style*))

Analogous to TmPrelude, SMathML also provides TnTmPrelude.

(define TnTmPrelude
  (compose Tn Tm Prelude))

第6.2节 Default Auxiliary Procedures

Tn is only an overall framework; for headings and entries, the present and cite functions have to be written before they can be used. SMathML therefore also provides some default auxiliary procedures.

(define (format-section section)
  (define sec (cdr (reverse section)))
  (apply string-append
         (add-between (map number->string sec) ".")))
(define (heading-present %heading attr* . html*)
  (define level (%heading-level %heading))
  (define auto? (%heading-auto? %heading))
  (define section (%heading-section %heading))
  (define id (%heading-id %heading))
  (cond ((= level 4) `(h4 ,(attr*-set attr* 'id id)
                          ,(format "第~a小节 " (format-section section))
                          . ,html*))
        ((= level 3) `(h3 ,(attr*-set attr* 'id id)
                          ,(format "第~a节 " (format-section section))
                          . ,html*))
        ((= level 2) `(h2 ,(attr*-set attr* 'id id)
                          ,(format "第~a章 " (format-section section))
                          . ,html*))
        ((= level 1) `(h1 ,(attr*-set attr* 'id id) . ,html*))
        (else (error 'heading-present "invalid level ~s" level))))
(define (h4-present %heading attr* . html*)
  (define auto? (%heading-auto? %heading))
  (define id (%heading-id %heading))
  (if auto?
      (let ((section (%heading-section %heading)))
        `(h4 ,(attr*-set attr* 'id id)
             ,(format "第~a小节 " (format-section section))
             . ,html*))
      `(h4 ,(attr*-set attr* 'id id) . ,html*)))
(define (h3-present %heading attr* . html*)
  (define auto? (%heading-auto? %heading))
  (define id (%heading-id %heading))
  (if auto?
      (let ((section (%heading-section %heading)))
        `(h3 ,(attr*-set attr* 'id id)
             ,(format "第~a节 " (format-section section))
             . ,html*))
      `(h3 ,(attr*-set attr* 'id id) . ,html*)))
(define (h2-present %heading attr* . html*)
  (define auto? (%heading-auto? %heading))
  (define id (%heading-id %heading))
  (if auto?
      (let ((section (%heading-section %heading)))
        `(h2 ,(attr*-set attr* 'id id)
             ,(format "第~a章 " (format-section section))
             . ,html*))
      `(h2 ,(attr*-set attr* 'id id) . ,html*)))
(define (h1-present %heading attr* . html*)
  (define id (%heading-id %heading))
  `(h1 ,(attr*-set attr* 'id id) . ,html*))
(define (heading-cite %heading)
  (define id (%heading-id %heading))
  (define href (string-append "#" id))
  (define section (%heading-section %heading))
  (define level (%heading-level %heading))
  (define ref
    `(a ((href ,href)) ,(format-section section)))
  (cond ((= level 4) (Cite "第" ref "小节"))
        ((= level 3) (Cite "第" ref "节"))
        ((= level 2) (Cite "第" ref "章"))
        (else
         (error 'heading-cite "invalid level ~s" level))))
(define (H1. #:attr* [attr* '()] #:id [id #f] #:auto? [auto? #t] . html*)
  `(,(build-%heading #:present h1-present #:level 1
                     #:id id #:auto? auto?)
    ,attr* . ,html*))
(define (H2. #:attr* [attr* '()] #:id [id #f]
             #:switch? [switch? #t] #:auto? [auto? #t] . html*)
  `(,(build-%heading #:present h2-present #:cite heading-cite
                     #:level 2 #:id id #:switch? switch?
                     #:auto? auto?)
    ,attr* . ,html*))
(define (H3. #:attr* [attr* '()] #:id [id #f]
             #:switch? [switch? #t] #:auto? [auto? #t] . html*)
  `(,(build-%heading #:present h3-present #:cite heading-cite
                     #:level 3 #:id id #:switch? switch?
                     #:auto? auto?)
    ,attr* . ,html*))
(define (H4. #:attr* [attr* '()] #:id [id #f]
             #:switch? [switch? #t] #:auto? [auto? #t] . html*)
  `(,(build-%heading #:present h4-present #:cite heading-cite
                     #:level 4 #:id id #:switch? switch?
                     #:auto? auto?)
    ,attr* . ,html*))

As for entries, SMathML does not yet provide any procedures for them. While writing the blog, the author did develop a standard set of routines, but the author always has to tweak them slightly for each page, so this code has not yet been merged into SMathML.

SMathML now provides a standard set of procedures for defining entries, and lets users adjust the numbering format through parameters. Users can also choose whether each kind of entry is numbered separately. The one flaw is that the citation format is fixed as the name of the entry kind followed by its number; perhaps the citation format should be parameterized in the future as well.

(define (format-num section index local?)
  (cond ((or (eq? (car section) '*)
             (not local?))
         (if index
             (format "~a" index)
             #f))
        (else
         (format "~a.~a"
                 (apply string-append
                        (add-between
                         (map number->string
                              (cdr (reverse section))) "."))
                 (if index index "*")))))
(define (format-head name section index local?)
  (let ((num ((parameter:format-num)
              section index local?)))
    (if num
        (B name (format "~a. " num))
        (B name ". "))))
(define local-entry?
  (make-parameter #t))
(define separate-class?
  (make-parameter #f))
(define parameter:format-num
  (make-parameter format-num))
(define parameter:format-head
  (make-parameter format-head))
(define (Entry name class)
  (define (present %entry attr* . html*)
    (define local? (%entry-local? %entry))
    (define id (%entry-id %entry))
    (define Attr* (attr*-set attr* 'class class 'id id))
    (define section (%entry-section %entry))
    (define index (%entry-index %entry))
    (define head ((parameter:format-head)
                  name section index local?))
    `(div ,Attr* ,head . ,html*))
  (define (cite %entry)
    (define local? (%entry-local? %entry))
    (define id (%entry-id %entry))
    (define href (string-append "#" id))
    (define section (%entry-section %entry))
    (define index (%entry-index %entry))
    (define num ((parameter:format-num)
                 section index local?))
    (if num
        (Cite name `(a ((href ,href)) ,num))
        (Cite `(a ((href ,href)) "某" ,name))))
  (lambda (#:id [id #f] #:auto? [auto? #t])
    (lambda (#:attr* [attr* '()] . html*)
      (cons (make-%entry
             (local-entry?)
             (if (separate-class?) class #f)
             id auto? #f #f present cite)
            (cons attr* html*)))))
(define-syntax-rule (define-Entry* (id name class) ...)
  (begin (define id (Entry name class))
         ...))
(define-Entry*
  (Axiom "公理" "axiom")
  (Definition "定义" "definition")
  (Lemma "引理" "lemma")
  (Theorem "定理" "theorem")
  (Corollary "推论" "corollary")
  (Example "例子" "example")
  (Notation "记号" "notation")
  (Comment "注记" "comment")
  (Proposition "命题" "proposition")
  (Remark "评注" "remark")
  (Exercise "练习" "exercise")
  (Convention "约定" "convention")
  (Warning "警告" "warning"))

第7章 Output

For SMathML to be of any actual use, we must provide a set of output procedures.

第7.1节 Outputting HTML/XML

To convert SXML into actual HTML/XML, we provide a procedure Xml, implemented as follows:

;<xml> ::= <string>
;       |  (<tag> (<attr>*) <xml>*)
;<tag> ::= <symbol>
;<attr> ::= (<symbol> <string>)
(define (Attr* attr*)
  (for-each
   (lambda (attr)
     (printf " ~s=~s" (car attr) (cadr attr)))
   attr*))
(define (Xml xml)
  (match xml
    (`(,tag ,attr* . ,xml*)
     #:when (symbol? tag)
     (if (null? xml*)
         (begin
           (printf "<~s" tag)
           (Attr* attr*)
           (printf "/>"))
         (begin
           (printf "<~s" tag)
           (Attr* attr*)
           (printf ">")
           (for-each Xml xml*)
           (printf "</~s>" tag))))
    ((? string? str)
     (printf "~a" str))))

第7.2节 Outputting CSS

;<attr> ::= (<symbol> <string>)
;<style> ::= (<string> <attr>*)
;<css> ::= (<style>*)
(define (Attr* attr*)
  (for-each
   (lambda (attr)
     (printf "~s: ~a;" (car attr) (cadr attr)))
   attr*))
(define (Style style)
  (printf "~a {" (car style))
  (Attr* (cdr style))
  (printf "}\n"))
(define (Css css)
  (for-each Style css))

第7.3节 Outputting to Files

Of course, outputting alone is not enough; we also provide some auxiliary procedures for outputting to files.

(define (size x)
  (cond ((pair? x) (+ (size (car x)) (size (cdr x))))
        ((null? x) 0)
        ((string? x) (string-length x))
        (else 1)))
(define replace? (make-parameter #f))
(define compute-size? (make-parameter #f))
(define ((emit proc) exp path)
  (define (emit-file)
    (when (compute-size?)
      (printf "size of [~a]: ~a\n" path (size exp)))
    (with-output-to-file path
      (lambda () (proc exp))
      #:exists 'replace))
  (if (file-exists? path)
      (if (replace?)
          (emit-file)
          (printf "~s exists, emit cancelled\n" path))
      (emit-file)))
(define ((emit-thunk proc) thunk path)
  (define (emit-file)
    (define exp (thunk))
    (when (compute-size?)
      (printf "size of [~a]: ~a\n" path (size exp)))
    (with-output-to-file path
      (lambda () (proc exp))
      #:exists 'replace))
  (if (file-exists? path)
      (if (replace?)
          (emit-file)
          (printf "~s exists, emit cancelled\n" path))
      (emit-file)))
(define ((emit-promise proc) promise path)
  (define (emit-file)
    (define exp (force promise))
    (when (compute-size?)
      (printf "size of [~a]: ~a\n" path (size exp)))
    (with-output-to-file path
      (lambda () (proc exp))
      #:exists 'replace))
  (if (file-exists? path)
      (if (replace?)
          (emit-file)
          (printf "~s exists, emit cancelled\n" path))
      (emit-file)))

We provide both emit-thunk and emit-promise because a promise caches the result of its computation. Sometimes, however, we may want to run benchmarks, and then a plain thunk suits our needs better. Either way, both procedures can save some work when many files need to be output. (This is of course not automated at all; the user has to decide by hand.)

Based on emit and emit-thunk, we provide the following procedures:

(define emitXml (emit Xml))
(define emitCss (emit Css))
(define emitXml-thunk (emit-thunk Xml))
(define emitCss-thunk (emit-thunk Css))
(define emitXml-promise
  (emit-promise Xml))
(define emitCss-promise
  (emit-promise Css))

第8章 Miscellaneous and Experimental Features

This chapter records various odds and ends provided by SMathML that do not fit into any system.

第8.1节 Escaping

SMathML provides a procedure of no arguments called escape*. Calling it starts an interactive session: paste the text to be escaped and press Enter, and you get the escaped text back.

(define (escape s)
  (define l (string-length s))
  (let iter ((i 0))
    (unless (= i l)
      (let ((c (string-ref s i)))
        (case c
          ((#\") (printf """))
          ((#\<) (printf "&lt;"))
          ((#\&) (printf "&amp;"))
          ((#\\) (printf "\\\\"))
          (else (printf "~a" c))))
      (iter (+ i 1)))))
(define (escape*)
  (escape (read-line))
  (newline)
  (escape*))

第8.2节 Variants of map

The following variants of map were all distilled from experience using SMathML.

(define (map2 proc lst)
  (cond ((null? lst) '())
        ((null? (cdr lst)) (list (proc (car lst))))
        (else (cons (proc (car lst) (cadr lst))
                    (map2 proc (cddr lst))))))
(define (map* f . x*) (map f x*))
(define (map-toggle flag proc lst)
  (cond ((null? lst) '())
        (flag (cons (proc (car lst))
                    (map-toggle (not flag) proc (cdr lst))))
        (else (cons (car lst)
                    (map-toggle (not flag) proc (cdr lst))))))

第8.3节 Dates

(define now (current-date))
(define (current-date-string #:format [format 'rfc2822])
  (parameterize ((date-display-format format))
    (date->string now #t)))

第8.4节 Upright Capital Greek Letters

Since upright capital Greek letters come up from time to time, SMathML provides the following definitions:

(define Γ $Gamma:normal)
(define Δ $Delta:normal)
(define Θ $Theta:normal)
(define Λ $Lambda:normal)
(define Ξ $Xi:normal)
(define Π $Pi:normal)
(define Σ $Sigma:normal)
(define Φ $Phi:normal)
(define Ψ $Psi:normal)
(define Ω $Omega:normal)

第8.5节 Maximum and Minimum

Mathematics of course often needs to express maxima and minima (as well as suprema and infima). Their forms vary so much, however, that SMathML provides only the following definitions:

(define $max (Mi "max"))
(define (&max . x*)
  (apply appl $max x*))
(define $min (Mi "min"))
(define (&min . x*)
  (apply appl $min x*))

Suprema and infima have now been added too; their definitions are equivalent to the following:

(define $supremum (Mi "sup"))
(define $infimum (Mi "inf"))
(define-bigop*
  (supremum $supremum)
  (infimum $infimum))

第8.6节 Indexing Matrix Entries and Its Generalization

(define (mref A i j)
  (_ A (&cm i j)))
(define (_cm A . x*)
  (_ A (apply &cm x*)))

第8.7节 The set- Family of Functions

SMathML provides some convenience functions whose names begin with set-, for modifying attributes, for example

(define (set-compact op)
  (set-attr* op 'lspace "0" 'rspace "0"))

(define (set-mathvariant i v)
  (set-attr* i 'mathvariant v))

(define (set-style x style)
  (set-attr* x 'style style))

第8.8节 RSS

SMathML provides some procedures for writing RSS, which have to be imported with (require SMathML/rss).

(define (Rss #:version [version "2.0"] channel)
  `(rss ((version ,version)) ,channel))
(define (Title str) `(title () ,str))
(define (Link str) `(link () ,str))
(define (Description str) `(description () ,str))
(define (Channel #:title title #:link link #:description description . xml*)
  `(channel () ,(Title title) ,(Link link) ,(Description description) . ,xml*))
(define (RC #:version [version "2.0"]
            #:title title #:link link #:description description
            . xml*)
  (Rss #:version version
       (keyword-apply
        Channel '(#:description #:link #:title) (list description link title)
        xml*)))
(define (Item . xml*) `(item () . ,xml*))
(define (PubDate str) `(pubDate () ,str))

第8.9节 General Folds over SXML

The folds given here are, in a sense, generalizations of the list operations fold-left and fold-right to SXML.

(define (fold-left proc init lst)
  (if (null? lst)
      init
      (fold-left proc (proc init (car lst)) (cdr lst))))
(define (fold-right proc init lst)
  (if (null? lst)
      init
      (proc (car lst)
            (fold-right proc init (cdr lst)))))
(define (Fold fdown fup fhere seed xml)
  (match xml
    (`(,tag ,attr* . ,xml*)
     (define entering
       (fdown seed tag attr* xml*))
     (define enjoying
       (fold-left
        (lambda (seed xml)
          (Fold fdown fup fhere seed xml))
        entering xml*))
     (fup seed enjoying tag attr* xml*))
    (else (fhere seed xml))))
(define (Fold* fdown fup fhere seed xml)
  (match xml
    (`(,tag ,attr* . ,xml*)
     (define-values (entering new*)
       (fdown seed tag attr* xml*))
     (define enjoying
       (fold-left
        (lambda (seed xml)
          (Fold* fdown fup fhere seed xml))
        entering new*))
     (fup seed enjoying tag attr* xml*))
    (else (fhere seed xml))))

第8.10节 HTML Pretty-Printing

All the code in this part was generated by an LLM and has not been reviewed by a human with full understanding. Use it with caution, and never use it in any production environment. That said, the XML provided here is arguably more conservative than most HTML pretty-printers. In principle, however, the correct indentation behavior of HTML depends on its CSS, so our pretty-printer cannot be completely correct.

Based on Fold from the previous section, we provide an HTML pretty-printer here. You can of course also use it to pretty-print XML, and we provide the parameter inline-tags to control indentation.

(struct state (idt ctx) #:transparent)
(define inline-tags
  (make-parameter
   (seteq
    'pre 'textarea 'script 'style
    'b 'i 'em 'strong 'span 'a 'u 's
    'code 'kbd 'samp 'var
    'abbr 'cite 'q 'sub 'sup 'small 'mark
    'del 'ins 'time 'wbr 'br
    'bdi 'bdo 'data 'ruby 'rt 'rp
    'img 'input 'output 'select 'button 'label
    'mi 'mn 'mo 'ms 'mtext 'mspace 'annotation
    'tspan 'textPath
    'math 'svg)))
(define (inline? tag)
  (set-member? (inline-tags) tag))
(define (inline-element? tag attr*)
  (and (inline? tag)
       (not (and (eq? tag 'math)
                 (for/or ([a (in-list attr*)])
                   (and (eq? (car a) 'display)
                        (equal? (cadr a) "block")))))
       (not (and (eq? tag 'svg)
                 (for/or ([a (in-list attr*)])
                   (and (eq? (car a) 'style)
                        (string-contains? (cadr a) "display: block")))))))
(define (XML xml)
  (define (fdown seed tag attr* xml*)
    (define idt (state-idt seed))
    (define ctx (state-ctx seed))
    (define child-inline?
      (inline-element? tag attr*))
    (cond
      [(eq? ctx 'inline)
       (void)]
      [(eq? ctx 'block-nl)
       (display (make-string idt #\space))]
      [else
       (unless child-inline?
         (newline)
         (display (make-string idt #\space)))])
    (printf "<~a" tag)
    (for ([a (in-list attr*)])
      (printf " ~a=~s" (car a) (cadr a)))
    (cond
      [(null? xml*)
       (display "/>")
       (when (and (not (eq? ctx 'inline)) (not child-inline?))
         (newline))
       seed]
      [else
       (display ">")
       (cond
         [(eq? ctx 'inline) (state idt 'inline)]
         [child-inline?     (state idt 'inline)]
         [else              (state (+ idt 2) 'block)])]))
  (define (fup seed enjoying tag attr* xml*)
    (when (pair? xml*)
      (when (eq? (state-ctx enjoying) 'block-nl)
        (display (make-string (state-idt seed) #\space)))
      (printf "</~a>" tag)
      (when (and (not (eq? (state-ctx seed) 'inline))
                 (not (inline-element? tag attr*)))
        (newline)))
    (cond
      [(eq? (state-ctx seed) 'inline) seed]
      [(inline-element? tag attr*)
       (state (state-idt seed) 'mixed)]
      [else
       (state (state-idt seed) 'block-nl)]))
  (define (fhere seed xml)
    (define ctx (state-ctx seed))
    (when (eq? ctx 'block-nl)
      (display (make-string (state-idt seed) #\space)))
    (display xml)
    (if (eq? ctx 'inline)
        seed
        (state (state-idt seed) 'mixed)))
  (Fold fdown fup fhere (state 0 'block-nl) xml))

第8.11节 LINK and TITLE

These functions were added only because the author's blog uses them a lot.

(define (LINK title link)
  (A title #:attr* `((href ,link))))
(define (TITLE title link)
  (H2 (LINK title link)))

第8.12节 Helpers for Defining XML Tags

make-xml-tag defines the SXML constructor for the tag named by its argument, while define-xml-tag* is a helper macro for defining many SXML constructors at once.

(define (make-xml-tag name)
  (lambda (#:attr* [attr* '()] . xml*)
    `(,name ,attr* . ,xml*)))
(define-syntax-rule
  (define-xml-tag* (id name) ...)
  (begin
    (define id (make-xml-tag 'name))
    ...))

第9章 SVG Drawing

SMathML's SVG drawing facilities are still very primitive and nearly unusable. Still, something is better than nothing.

第9.1节 Basic Functions

(define (A #:attr* [attr* '()] . svg*)
  `(a ,attr* . ,svg*))
(define (Animate #:attr* [attr* '()] . svg*)
  `(animate ,attr* . ,svg*))
(define (AnimateMotion #:attr* [attr* '()] . svg*)
  `(animateMotion ,attr* . ,svg*))
(define (AnimateTransform #:attr* [attr* '()] . svg*)
  `(animateTransform ,attr* . ,svg*))
(define (Circle #:attr* [attr* '()] . svg*)
  `(circle ,attr* . ,svg*))
(define (ClipPath #:attr* [attr* '()] . svg*)
  `(clipPath ,attr* . ,svg*))
(define (Defs #:attr* [attr* '()] . svg*)
  `(defs ,attr* . ,svg*))
(define (Desc #:attr* [attr* '()] . svg*)
  `(desc ,attr* . ,svg*))
(define (Ellipse #:attr* [attr* '()] . svg*)
  `(ellipse ,attr* . ,svg*))
(define (FeBlend #:attr* [attr* '()] . svg*)
  `(feBlend ,attr* . ,svg*))
(define (FeColorMatrix #:attr* [attr* '()] . svg*)
  `(feColorMatrix ,attr* . ,svg*))
(define (FeComponentTransfer #:attr* [attr* '()] . svg*)
  `(feComponentTransfer ,attr* . ,svg*))
(define (FeComposite #:attr* [attr* '()] . svg*)
  `(feComposite ,attr* . ,svg*))
(define (FeConvolveMatrix #:attr* [attr* '()] . svg*)
  `(feConvolveMatrix ,attr* . ,svg*))
(define (FeDiffuseLighting #:attr* [attr* '()] . svg*)
  `(feDiffuseLighting ,attr* . ,svg*))
(define (FeDisplacementMap #:attr* [attr* '()] . svg*)
  `(feDisplacementMap ,attr* . ,svg*))
(define (FeDistantLight #:attr* [attr* '()] . svg*)
  `(feDistantLight ,attr* . ,svg*))
(define (FeDropShadow #:attr* [attr* '()] . svg*)
  `(feDropShadow ,attr* . ,svg*))
(define (FeFlood #:attr* [attr* '()] . svg*)
  `(feFlood ,attr* . ,svg*))
(define (FeFuncA #:attr* [attr* '()] . svg*)
  `(feFuncA ,attr* . ,svg*))
(define (FeFuncB #:attr* [attr* '()] . svg*)
  `(feFuncB ,attr* . ,svg*))
(define (FeFuncG #:attr* [attr* '()] . svg*)
  `(feFuncG ,attr* . ,svg*))
(define (FeFuncR #:attr* [attr* '()] . svg*)
  `(feFuncR ,attr* . ,svg*))
(define (FeGaussianBlur #:attr* [attr* '()] . svg*)
  `(feGaussianBlur ,attr* . ,svg*))
(define (FeImage #:attr* [attr* '()] . svg*)
  `(feImage ,attr* . ,svg*))
(define (FeMerge #:attr* [attr* '()] . svg*)
  `(feMerge ,attr* . ,svg*))
(define (FeMergeNode #:attr* [attr* '()] . svg*)
  `(feMergeNode ,attr* . ,svg*))
(define (FeMorphology #:attr* [attr* '()] . svg*)
  `(feMorphology ,attr* . ,svg*))
(define (FeOffset #:attr* [attr* '()] . svg*)
  `(feOffset ,attr* . ,svg*))
(define (FePointLight #:attr* [attr* '()] . svg*)
  `(fePointLight ,attr* . ,svg*))
(define (FeSpecularLighting #:attr* [attr* '()] . svg*)
  `(feSpecularLighting ,attr* . ,svg*))
(define (FeSpotLight #:attr* [attr* '()] . svg*)
  `(feSpotLight ,attr* . ,svg*))
(define (FeTile #:attr* [attr* '()] . svg*)
  `(feTile ,attr* . ,svg*))
(define (FeTurbulence #:attr* [attr* '()] . svg*)
  `(feTurbulence ,attr* . ,svg*))
(define (Filter #:attr* [attr* '()] . svg*)
  `(filter ,attr* . ,svg*))
(define (ForeignObject #:attr* [attr* '()] . svg*)
  `(foreignObject ,attr* . ,svg*))
(define (G #:attr* [attr* '()] . svg*)
  `(g ,attr* . ,svg*))
(define (Image #:attr* [attr* '()] . svg*)
  `(image ,attr* . ,svg*))
(define (Line #:attr* [attr* '()] . svg*)
  `(line ,attr* . ,svg*))
(define (LinearGradient #:attr* [attr* '()] . svg*)
  `(linearGradient ,attr* . ,svg*))
(define (Marker #:attr* [attr* '()] . svg*)
  `(marker ,attr* . ,svg*))
(define (Mask #:attr* [attr* '()] . svg*)
  `(mask ,attr* . ,svg*))
(define (Metadata #:attr* [attr* '()] . svg*)
  `(metadata ,attr* . ,svg*))
(define (Mpath #:attr* [attr* '()] . svg*)
  `(mpath ,attr* . ,svg*))
(define (Path #:attr* [attr* '()] . svg*)
  `(path ,attr* . ,svg*))
(define (Pattern #:attr* [attr* '()] . svg*)
  `(pattern ,attr* . ,svg*))
(define (Polygon #:attr* [attr* '()] . svg*)
  `(polygon ,attr* . ,svg*))
(define (Polyline #:attr* [attr* '()] . svg*)
  `(polyline ,attr* . ,svg*))
(define (RadialGradient #:attr* [attr* '()] . svg*)
  `(radialGradient ,attr* . ,svg*))
(define (Rect #:attr* [attr* '()] . svg*)
  `(rect ,attr* . ,svg*))
(define (Script #:attr* [attr* '()] . svg*)
  `(script ,attr* . ,svg*))
(define (Set #:attr* [attr* '()] . svg*)
  `(set ,attr* . ,svg*))
(define (Stop #:attr* [attr* '()] . svg*)
  `(stop ,attr* . ,svg*))
(define (Style #:attr* [attr* '()] . svg*)
  `(style ,attr* . ,svg*))
(define (Svg #:attr* [attr* '()] . svg*)
  `(svg ,attr* . ,svg*))
(define (Switch #:attr* [attr* '()] . svg*)
  `(switch ,attr* . ,svg*))
(define (Symbol #:attr* [attr* '()] . svg*)
  `(symbol ,attr* . ,svg*))
(define (Text #:attr* [attr* '()] . svg*)
  `(text ,attr* . ,svg*))
(define (TextPath #:attr* [attr* '()] . svg*)
  `(textPath ,attr* . ,svg*))
(define (Title #:attr* [attr* '()] . svg*)
  `(title ,attr* . ,svg*))
(define (Tspan #:attr* [attr* '()] . svg*)
  `(tspan ,attr* . ,svg*))
(define (Use #:attr* [attr* '()] . svg*)
  `(use ,attr* . ,svg*))
(define (View #:attr* [attr* '()] . svg*)
  `(view ,attr* . ,svg*))

第9.2节 Graphics Library

Since there is not yet a good design that is workable in practice, the graphics library provides only the most basic functions, which cannot go wrong. To the author, the Penrose library seems the ideal way to lay out diagrams.

(struct pt (x y) #:transparent)
(struct vec (x y) #:transparent)
(define (vec+ u v)
  (vec (+ (vec-x u) (vec-x v))
       (+ (vec-y u) (vec-y v))))
(define (vec- u v)
  (vec (- (vec-x u) (vec-x v))
       (- (vec-y u) (vec-y v))))
(define (vec* s v)
  (vec (* s (vec-x v))
       (* s (vec-y v))))
(define (pt+ p v)
  (pt (+ (pt-x p) (vec-x v))
      (+ (pt-y p) (vec-y v))))
(define (pt- p q)
  (vec (- (pt-x p) (pt-x q))
       (- (pt-y p) (pt-y q))))
(define (dot u v)
  (+ (* (vec-x u) (vec-x v))
     (* (vec-y u) (vec-y v))))
(define (vec-len v)
  (sqrt (dot v v)))
(define (vec-normalize v)
  (vec* (/ 1 (vec-len v)) v))
(define (pt-lerp p q t)
  (pt+ p (vec* t (pt- q p))))

For now we have added the following primitives as well; clearly more will be needed in the future.

(define (n2s n)
  (~r n #:precision 2))
(define stroke-width
  (make-parameter "1px"))
(define (:line start end)
  (define x1 (n2s (pt-x start)))
  (define y1 (n2s (pt-y start)))
  (define x2 (n2s (pt-x end)))
  (define y2 (n2s (pt-y end)))
  `(line ((x1 ,x1)
          (y1 ,y1)
          (x2 ,x2)
          (y2 ,y2)
          (stroke-width
           ,(stroke-width)))))
(define arrow-head
  (Marker
   #:attr*
   '((id "arrow-head")
     (viewbox "0 0 10 10")
     (refX "5")
     (refY "5")
     (markerWidth "6")
     (markerHeight "6")
     (orient "auto-start-reverse"))
   (Path #:attr* '((d "M 0 2 L 6 5 L 0 8 z")))))
(define (:arrow start end)
  (define x1 (n2s (pt-x start)))
  (define y1 (n2s (pt-y start)))
  (define x2 (n2s (pt-x end)))
  (define y2 (n2s (pt-y end)))
  `(line ((x1 ,x1)
          (y1 ,y1)
          (x2 ,x2)
          (y2 ,y2)
          (stroke-width
           ,(stroke-width))
          (marker-end
           "url(#arrow-head)"))))

第10章 Gallery

This chapter offers practical examples of SMathML, to spark readers' imagination and help them make better use of SMathML.

第10.1节 The Binomial Theorem

This is the simplest and most basic example, involving no high-level abstraction.

(MB (&= (^ (@+ $x $y) $n)
        (sum (&= $k $0) $n
             (&i* (comb $n $k)
                  (^ $x (&- $n $k))
                  $y^k))))

<math display="block">
  <mrow>
    <msup>
      <mrow><mo stretchy="false">(</mo>
        <mrow><mi>x</mi><mo>+</mo><mi>y</mi></mrow>
        <mo stretchy="false">)</mo></mrow>
      <mi>n</mi></msup>
    <mo>=</mo>
    <mrow>
      <munderover><mo>&sum;</mo>
        <mrow><mi>k</mi><mo>=</mo><mn>0</mn></mrow>
        <mi>n</mi></munderover>
      <mrow>
        <mrow><mo>(</mo>
          <mfrac linethickness="0"><mi>n</mi><mi>k</mi></mfrac>
          <mo>)</mo></mrow>
        <mo>&it;</mo>
        <msup><mi>x</mi>
          <mrow><mi>n</mi><mo>&minus;</mo><mi>k</mi></mrow>
        </msup>
        <mo>&it;</mo>
        <msup><mi>y</mi><mi>k</mi></msup>
      </mrow>
    </mrow>
  </mrow>
</math>

第10.2节 Napier's Bones

Napier's bones are a calculating tool devised by Napier, the inventor of logarithms; their most basic use is multiplication. Below we write code to typeset the process of multiplying with Napier's bones.

(define (char->mn c)
  (Mn (string c)))
(define (add0 l)
  (if (null? (cdr l))
      (cons #\0 l)
      l))
(define (cell ab)
  (define-values (c d)
    (apply values
           (map char->mn
                (add0 (string->list
                       (number->string (apply * ab)))))))
  (Menclose
   #:attr* '((notation "updiagonalstrike"))
   (Mtable
    #:attr* '((frame "solid"))
    (Mtr (Mtd c) (Mtd $))
    (Mtr (Mtd $) (Mtd d)))))
(define 1--9 (range 1 10))
(define (product l1 l2)
  (map (lambda (x)
         (map (lambda (y) (list x y))
              l2))
       l1))
(define (tmap f t)
  (map (lambda (l) (map f l)) t))
(define (list->table lst)
  (keyword-apply
   Mtable
   '(#:attr*)
   '(((rowspacing "0")
      (columnspacing "0")))
   (map (lambda (row)
          (apply Mtr (map Mtd row)))
        lst)))
(define (napier m n)
  (list->table
   (tmap cell (product m n))))

Let us look at a few examples.

(P (MB (napier 1--9 1--9))
   "This is a complete table of Napier's bones.")

$$\begin{array}{ccccccccc}\cancel{\begin{array}{|cc|}\hline 0& \\ & 1\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 3\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 7\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 9\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 0& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 8\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 0& \\ & 3\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 9\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 1\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 7\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 0& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 6\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 0& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 5\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 0& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 5& \\ & 4\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 0& \\ & 7\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 1\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 9\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 5& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 6& \\ & 3\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 0& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 5& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 6& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 7& \\ & 2\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 0& \\ & 9\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 7\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 5& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 6& \\ & 3\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 7& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 8& \\ & 1\\ \hline\end{array}}\end{array}$$ This is a complete table of Napier's bones.

(P (MB (napier '(4 6 7 8 5 3 9 9)
               '(9 6 4 3 1)))
   (MB (&= (&c* 46785399 96431)
           (* 46785399 96431))))

$$\begin{array}{ccccc}\cancel{\begin{array}{|cc|}\hline 3& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 4\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 5& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 6\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 6& \\ & 3\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 1\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 7\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 7& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 4& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 8\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 4& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 0\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 5\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 5\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 2& \\ & 7\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 8\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 1& \\ & 2\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 9\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 3\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 8& \\ & 1\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 5& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 7\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 9\\ \hline\end{array}}\\ \cancel{\begin{array}{|cc|}\hline 8& \\ & 1\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 5& \\ & 4\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 3& \\ & 6\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 2& \\ & 7\\ \hline\end{array}}& \cancel{\begin{array}{|cc|}\hline 0& \\ & 9\\ \hline\end{array}}\end{array}$$ $$46785399\times 96431=4511562810969$$

第10.3节 The Simply Typed $\lambda$-Calculus

The $\lambda$-calculus is an intensional theory of functions. The typing rules of the (Church-style) simply typed $\lambda$-calculus are as follows:

(MB (&rull "(Var)"
           (&= (app Γ $x) $tau)
           (G!- (&: $x $tau))))

(MB (&rull "(Abs)"
           (G!- (&: $x $tau_1)
                (&: $e $tau_2))
           (G!- (&: (Lam (&: $x $tau_1) $e)
                    (&-> $tau_1 $tau_2)))))

(MB (&rull "(App)"
           (G!- (&: $e_1 (&-> $tau_1 $tau_2)))
           (G!- (&: $e_2 $tau_1))
           (G!- (&: (App $e_1 $e_2) $tau_2))))

(define $!- (Mo "⊢"))
(define (!- . x*)
  (let-values (((a* b*) (split-at-right x* 1)))
    (: (apply &cm a*) $!- (car b*))))
(define (G!- . x*)
  (apply !- Γ x*))
(define (Lam x t)
  (: $lambda x $. t))
(define App (&split 2))
(define (&rule #:space [n 8] . j*)
  (let-values (((j* j1) (split-at-right j* 1)))
    (~ #:attr* '((displaystyle "true"))
       (apply (&split n) j*) (car j1))))
(define (&rull label . x*)
  (: (apply &rule x*) label))

第10.4节 Natural Deduction (for Intuitionistic Propositional Logic)

Here we present an EDSL built on SMathML that checks a proof and then generates the corresponding natural deduction tree. This example would probably be rather hard to implement in other typesetting systems.

(define (type-of var env)
  (cond ((assoc var env) => cdr)
        (else (error 'type-of "unknown variable ~s" var))))
(define (extend-env var type env)
  (cons (cons var type) env))
(define (reify t)
  (define (reify t)
    (match t
      ((-> ,t1 ,t2) (&impl (@reify t1) (@reify t2)))
      ((conj ,t1 ,t2) (&conj (@reify t1) (@reify t2)))
      ((disj ,t1 ,t2) (&disj (@reify t1) (@reify t2)))
      (bot $bottom)
      (top $top)
      (,else t)))
  (define (@reify t)
    (match t
      ((-> ,t1 ,t2) (@impl (@reify t1) (@reify t2)))
      ((conj ,t1 ,t2) (@conj (@reify t1) (@reify t2)))
      ((disj ,t1 ,t2) (@disj (@reify t1) (@reify t2)))
      (bot $bottom)
      (top $top)
      (,else t)))
  (reify t))
(struct result (t c) #:transparent)
(define (VAR u)
  (lambda (env)
    (define t (type-of u env))
    (result t (assume u (&true (reify t))))))
(define (CONS a b)
  (lambda (env)
    (match-define (result ta ca) (a env))
    (match-define (result tb cb) (b env))
    (define type `(conj ,ta ,tb))
    (result type
            (&rull $conjI ca cb
                   (&true (reify type))))))
(define (CAR a)
  (lambda (env)
    (match-define (result ta ca) (a env))
    (match ta
      ((conj ,t1 ,t2)
       (result t1 (&rull $conjE1 ca
                         (&true (reify t1))))))))
(define (CDR a)
  (lambda (env)
    (match-define (result ta ca) (a env))
    (match ta
      ((conj ,t1 ,t2)
       (result t2 (&rull $conjE2 ca
                         (&true (reify t2))))))))
(define (LAM u t body)
  (lambda (env)
    (match-define (result tbody cbody)
      (body (extend-env u t env)))
    (define type `(-> ,t ,tbody))
    (result type
            (&rull (&implI u) cbody
                   (&true (reify type))))))
(define (APP a b)
  (lambda (env)
    (match-define (result ta ca) (a env))
    (match-define (result tb cb) (b env))
    (match ta
      ((-> ,t1 ,t2)
       (unless (equal? t1 tb)
         (error 'APP "type mismatch"))
       (result t2 (&rull $implE ca cb
                         (&true (reify t2))))))))
(define (INL tb a)
  (lambda (env)
    (match-define (result ta ca) (a env))
    (define type `(disj ,ta ,tb))
    (result type (&rull $disjI1 ca
                        (&true (reify type))))))
(define (INR ta b)
  (lambda (env)
    (match-define (result tb cb) (b env))
    (define type `(disj ,ta ,tb))
    (result type (&rull $disjI2 cb
                        (&true (reify type))))))
(define (CASE a u1 b1 u2 b2)
  (lambda (env)
    (match-define (result ta ca) (a env))
    (match ta
      ((disj ,t1 ,t2)
       (match-define (result tb1 cb1)
         (b1 (extend-env u1 t1 env)))
       (match-define (result tb2 cb2)
         (b2 (extend-env u2 t2 env)))
       (unless (equal? tb1 tb2)
         (error 'CASE "branch type mismatch"))
       (result tb1 (&rull (&disjE u1 u2) ca cb1 cb2
                          (&true (reify tb1))))))))
(define (ND proof)
  (result-c (proof '())))

Now let us look at some examples.

(MB (ND (LAM $u `(-> (disj ,$A ,$B) ,$C)
             (CONS (LAM $w $A
                        (APP (VAR $u)
                             (INL $B (VAR $w))))
                   (LAM $x $B
                        (APP (VAR $u)
                             (INR $A (VAR $x))))))))

(MB (ND (LAM $u `(conj (-> ,$A ,$C) (-> ,$B ,$C))
             (LAM $w `(disj ,$A ,$B)
                  (CASE (VAR $w)
                        $x (APP (CAR (VAR $u)) (VAR $x))
                        $y (APP (CDR (VAR $u)) (VAR $y)))))))

(let ((Neg (lambda (A) `(-> ,A bot))))
  (MB (ND (LAM $u (Neg `(disj ,$A ,(Neg $A)))
               (APP (LAM $v (Neg $A)
                         (APP (VAR $u)
                              (INR $A (VAR $v))))
                    (LAM $w $A
                         (APP (VAR $u)
                              (INL (Neg $A) (VAR $w)))))))))

第11章 Comparison with Other Tools

The items chosen for comparison here overlap with SMathML either in functionality or in design decisions. I had not heard of many of them before designing and implementing SMathML; I only learned of them recently, with the help of LLMs.

第11.1节 Oleg Kiselyov's SXML

SXML is not just SXML itself; it also comprises a family of tools for processing SXML, including SSAX, SXPath and SXSLT. The names SXML, SSAX, SXPath and SXSLT suggest their connection with XML, SAX, XPath and XSLT. This does not mean, however, that these S-prefixed tools work merely at the level of syntax, that is, that they merely translate the conventional syntax into the parenthesized syntax of Lisp-family languages.

第11.2节 DSSSL

DSSSL is similar in function to XSLT, but was originally designed for SGML, though it later came to support XML as well. What is most distinctive about DSSSL is that it is based on Scheme.

第11.3节 LAML

LAML and SMathML share many ideas, yet they also differ in many details. For example, LAML lets symbols serve as attribute names, with the strings that follow them serving as attribute values. This (concrete) syntax might also be adopted in ports of SMathML to other Scheme dialects and implementations. LAML also chooses to insert implicit spaces between pieces of content. These differences open a wide gap between LAML's surface syntax and the underlying syntax tree, which I personally do not like.

第11.4节 (Scheme) Scribe

第11.5节 Skribe

第11.6节 Skribilo

第11.7节 Beautiful Report Language

第11.8节 Scribble

第11.9节 TeXmacs

第11.10节 LaTeX

LaTeX is the de facto standard for mathematical documents. Almost all mathematics journals and preprint servers require submissions in LaTeX, although in academic mathematics Word is often accepted as an alternative.

第11.11节 Typst

第11.12节 SATysFi

第11.13节 MarkDown

MarkDown may originally have been meant only as an easy way to write simple HTML. Because of its popularity, however, today's many MarkDown-based schemes carry far too many requirements that were never originally considered. Given MarkDown's inherent shortcomings in syntax design and other respects, these extensions strike me personally as exceptionally ugly.