melt-1.4.0/0000755000175000017500000000000011661167412012016 5ustar romainromainmelt-1.4.0/TODO0000644000175000017500000000324411661167412012511 0ustar romainromainTO DO ===== * Protect the name of the verbatim functions when using the pragma. The pragma ##verbatim '#' = test should become let __meltpp_verbatim_delimiter_0 = test and this fresh name should be used instead. * Find a Unicode lexer. Menhir? Ulex of Alain Frisch? * itemize: newline after => latex error, par after => nothing (no par) * Problem with make install who doesn't copy all files ? * configure.ml should read Config * Ocamlfind for install * Default <# ... #> using texttt * Really find out about the spaces at the beginning of lines in verbatim mode, with or without Beamer * Definitely get rid of textbf/mathbf and add "bf" (with a parameter, not like the LaTeX \bf). The CMT mechanism should be able to handle this. Do the same for it, sc, and so on. * Better integration with Ocamlbuild. Maybe a symbolic link from _melt/toto to the current directory, adding -I toto to the Ocamlbuild command? * "display" command, replacing displaymath maybe, with options (center? ...)z * \addvspace bug: LaTeX complains about "perhaps a missing \item" * _ and ^ support? * Better compilation of new lines: prevent the "no line to end" error * Melt.Verbatim.trim_end and trim_begin * Prettier LaTeX pretty-printing * pseudocode: find a way to better handle spaces and indentation * newtheorem and counters * better array (without array_line?), tabular * easier local "let"s * colors: move Beamer.color outside and complete it (see http://www.commentcamarche.net/contents/latex/latex-mise-en-forme.php3) * check the hfill size; what is the difference with the hfill command? * bug: {index rightarrow "<%R%>"} becomes $\rightarrow_$ * configuration: look in /usr/local toomelt-1.4.0/README0000644000175000017500000001071711661167412012704 0ustar romainromain************************************************************************** * Copyright (c) 2009, Romain BARDOU * * All rights reserved. * * * * Redistribution and use in source and binary forms, with or without * * modification, are permitted provided that the following conditions are * * met: * * * * * Redistributions of source code must retain the above copyright * * notice, this list of conditions and the following disclaimer. * * * Redistributions in binary form must reproduce the above copyright * * notice, this list of conditions and the following disclaimer in the * * documentation and/or other materials provided with the distribution. * * * Neither the name of Melt nor the names of its contributors may be * * used to endorse or promote products derived from this software * * without specific prior written permission. * * * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR * * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT * * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT * * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE * * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * ************************************************************************** More information can be found on: http://melt.forge.ocamlcore.org/ Pre-requisites ============== You need the OCaml compiler. Version 3.09 is enough, maybe some previous versions will work too. Version 3.10.2 is needed if you want to compile using Ocamlbuild. Version 3.11 is needed if you want to be able to use native plugins for the Melt Preprocessor. To compile Melt documents you need a LaTeX distribution. To compile Melt documents which use Mlpost figures you need the Mlpost library. Versions from 0.6 to 0.8.1 are compatible. You will also need its dependencies, such as Metapost and the "context" package (Ubuntu, Debian, ...). Mlpost can be found at: http://mlpost.lri.fr You can compile and use Melt without Mlpost, but you will need to compile your Melt documents using the -no-mlpost option. If you later install Mlpost and want to use it with Melt you will have to recompile Melt. Quick install (OCaml 3.10.2 or more) ==================================== make make install Quick install (Without Ocamlbuild) ================================== make -f noob.makefile make -f noob.makefile install Configuration ============= The configuration tool is automatically launched the first time you run make. You can rerun it at any time by removing the Config file and running make again, or by running: ocaml configure.ml -i The -i option activates interactive mode. If you don't use it, default values will be used. You can also edit the Config file by hand. Documentation ============= You can compile the documentation of Melt yourself. The manual can be compiled with: cd bench melt -pdf doc.mlt You obtain the file doc.pdf. The library documentation is automatically compiled when you run make. It can be found in: _build/latex/latex.docdir/index.html _build/melt/melt.docdir/index.html or, if you compiled without Ocamlbuild: latex/latex.docdir/index.html melt/melt.docdir/index.html Vim Plugin ========== Vincent Aravantinos made a Melt plugin for the Vim text editor. You can find it here: http://www.vim.org/scripts/script.php?script_id=2787 Author and contributions ======================== This project was started by Romain Bardou, and received several contributions from: Vincent Aravantinos François Bobot Pierre Chambart Arnaud Spiwack melt-1.4.0/_tags0000644000175000017500000000016111661167412013034 0ustar romainromain: use_unix, use_str : use_unix, use_str : use_unix, use_dynlink, use_str melt-1.4.0/latex/0000755000175000017500000000000011661167412013133 5ustar romainromainmelt-1.4.0/latex/latex.mli0000644000175000017500000011776611661167412014775 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (** LaTeX output. *) (** LaTeX expressions. *) type t (** {2 LaTeX Pervasives} *) type size = [ | `In of float | `Mm of float | `Cm of float | `Pt of float | `Em of float | `Ex of float | `Pc of float | `Bp of float | `Dd of float | `Cc of float | `Sp of float | `Parindent of float | `Baselineskip of float | `Baselinestretch of float | `Parskip of float | `Textwidth of float | `Linewidth of float | `Textheight of float | `Unitlength of float | `Fill | `Stretch of int ] (** The type of LaTeX sizes. - [`In]: inches - [`Mm]: millimeters - [`Cm]: centimeters - [`Pt]: points (about 1/72 inch) - [`Em]: approximately the width of an "M" in the current font - [`Ex]: approximately the width of an "x" in the current font - [`Pc]: pica (12pt/pc) - [`Bp]: big pt (72bp/in) - [`Dd]: didot (1157dd=1238pt) - [`Cc]: cicero (12dd/cc) - [`Sp]: scaled point (65536sp/pt) - [`Parindent]: normal paragraph indentation - [`Baselineskip]: normal vertical distance between lines in a paragraph - [`Baselinestretch]: multiplies [`Baselineskip] - [`Parskip]: the extra vertical space between paragraphs - [`Textwidth]: the width of text on the page - [`Linewidth]: width of a line in the local environment - [`Textheight]: the height of text on the page - [`Unitlength]: units of length in picture environment - [`Fill]: rubber length; takes as much space as possible - [`Stretch]: rubber length; if multiple [`Stretch]-sized commands are issued on the same line (or vertical box) they stretch in proportion of their respective factor. *) val latex_of_size : size -> t (** Low level function to be used to make new bindings. *) (** {3 Document} *) type documentclass = [ `Article | `Report | `Book | `Letter | `Slides | `Beamer | `Custom of string] type documentoptions = [ `Landscape | `A4paper | `TwoColumn | `Pt of int ] val document: ?documentclass: documentclass -> ?options: documentoptions list -> ?title: t -> ?author: t -> ?date: t -> ?prelude: t -> ?packages: (t * t) list -> t -> t (** The [~packages] argument takes a list of [(name, opt)] where [name] is the name of the package and [opt] is its option. This is equivalent to using several calls to [usepackage] in the [~prelude]. *) (** {3 Variables} *) (** {4 Basic Constructors} *) (** Variables are similar to LaTeX counters, except that they are computed when pretty-printing the LaTeX AST. The two basic operations on variables are [get] and [setf]. [get] outputs an ast depending on the current contents of a variable. [setf] updates the contents of a variable. [get] can also use the contents of a variable at a different position in the document. To use a position, you need to declare one first with [position]. then you can place that position in you document with [place]. You must not place a position more than one time. If a position isn't placed, the contents of the variables at that position will be the default one. The final contents of variables is obtained by a fixpoint computation wich is performed by the printing functions {!to_buffer}, {!to_channel}, {!to_file}, {!to_string}. That fixpoint may not terminate. In that case, the log will tell you which variable did not converge. *) type 'a variable val variable: ?eq:('a -> 'a -> bool) -> ?name:string -> ?printer:('a -> string) -> 'a -> 'a variable (** Declare a new variable. The last argument is the default value of the variable. [eq] is the equality function on the type of the variable. Default is [=]. [name] and [printer] are used to print information when the fixpoint calculation diverged. *) val setf: 'a variable -> ('a -> 'a) -> t (** Change the value of a variable in the rest of the document. *) val setf2: 'a variable -> 'b variable -> ('a -> 'b -> 'b) -> t (** [setf var_in var_out f] Change the value of the variable [var_out] in the rest of the document using the contents of [var_in]. *) type position (** The type of positions in documents. *) val position: ?name:string -> unit -> position (** Declare a new position. [name] is used to print information when the fixpoint computation diverged. *) val place: position -> t (** Place a position in the document. *) val get: ?position:position -> 'a variable -> ('a -> t) -> t (** Use the contents of a variable to compute part of the document. If [get] has no parameter [position] then the current value of the variable is taken. Otherwise it is the value at [position]. *) (** {4 Useful Stuff About Variables} *) (** All these functions are defined using the above constructors. *) val set: 'a variable -> 'a -> t (** Change the value of a variable. [set x v]: return a node which, when evaluated, changes the contents of variable [x] to value [v]. *) val final: 'a variable -> ('a -> t) -> t (** Like [get], but the value of the variable is taken at the end of the document. *) val incr_var: int variable -> t (** Increment an integer variable. [incr_var x] is equivalent to [setf x (fun x -> x + 1)]. *) val decr_var: int variable -> t (** Decrement an integer variable. [decr_var x] is equivalent to [setf x (fun x -> x - 1)]. *) val vari: int variable -> t (** Print an integer variable. [vari x] is equivalent to [get x (fun x -> text (string_of_int x))]. *) val varf: float variable -> t (** Print a float variable. [varf x] is equivalent to [get x (fun x -> text (string_of_float x))]. *) val varb: bool variable -> t (** Print a boolean variable. [varb x] is equivalent to [get x (fun x -> text (string_of_bool x))]. *) val vars: string variable -> t (** Print a string variable. [vars x] is equivalent to [get x text]. *) val vart: t variable -> t (** Print a variable containing a LaTeX AST. [vart x] is equivalent to [get x (fun x -> x)]. *) val finali: int variable -> t (** Print the last value of an integer variable. [finali x] is equivalent to [final x (fun x -> text (string_of_int x))]. *) val finalf: float variable -> t (** Print the last value of a float variable. [finalf x] is equivalent to [final x (fun x -> text (string_of_float x))]. *) val finalb: bool variable -> t (** Print the last value of a boolean variable. [finalb x] is equivalent to [final x (fun x -> text (string_of_bool x))]. *) val finals: string variable -> t (** Print the last value of a string variable. [finals x] is equivalent to [final x text]. *) val finalt: t variable -> t (** Print the last value of a variable containing a LaTeX AST. [finalt x] is equivalent to [final x (fun x -> x)]. *) (** {3 References and Labels} *) (** Example (using the Melt pre-processor): [let lbl_intro = label ()] [let intro = section ~label: lbl_intro "This is Section~{ref_ lbl_intro}."] *) type label val label: ?name: string -> unit -> label (** Declare a new label. Argument [name] can be used to force the name of the label in the LaTeX file. This can be useful if you need to refer to this label in an external LaTeX file or if the label itself is declared in another LaTeX file. The default value of [name] is ["latex_lib_label_n"] where [n] is a counter. *) val ref_: label -> t (** Make a reference to the label. *) (** {3 Figures} *) type float_position = [ `H | `T | `P | `B | `Force ] (** Floating element (figure, ...) positions. - [`H]: here - [`T]: top of page - [`B]: bottom of page - [`P]: put on a special page for floats only - [`Force]: override internal LaTeX parameters *) val float_all: float_position list (** [[ `H; `T; `B; `P ]] *) val figure: ?label: label -> ?pos: float_position list -> ?center: bool -> ?side_caption: bool -> ?caption: t -> ?wide: bool -> t -> t (** Floating figure. Default value for [center] is false. If [side_caption] is [true], the caption will be placed at the side of the figure instead of at the bottom. This uses package [sidecap]. Default value is [false]. Argument [~wide: true] must be used for multi-columns documents if you want the figure to use the full width of the page. In this case, positions [`H] has no effect, and position [`B] adds package [stfloats]. To prevent wide figures from being placed out-of-order with respect to their "non-wide" counterparts, use package [fixltx2e]. *) type wrapfigure_position = [ `L | `R | `I | `O | `Force of [ `L | `R | `I | `O ] ] (** Figure positions for package [wrapfig]. - [`L]: left - [`R]: right - [`I]: inside (if document is twosided) - [`O]: outside (if document is twosided) - [`Force _]: force the figure to start precisely where specified (may cause it to run over page breaks) *) val wrapfigure: ?label: label -> ?pos: wrapfigure_position -> ?lines: int -> ?width: size -> ?center: bool -> ?caption: t -> t -> t (** Floating figure which makes text wrap around it. Uses package [wrapfig]. Argument [lines] specifies the height of the figure in number of lines. It can be useful if LaTeX fails to compute it correctly. Default value for [width] is half the text width. Default value for [center] is false. If there is too much space on top and below the figure, and [lines] does not do what you want, you can add some negative [vspace]s. In general it is better to let LaTeX place the figure for you, though. *) type floatingfigure_position = [ `L | `R | `P ] (** Figure positions for package [floatflt]. - [`L]: left - [`R]: right - [`P]: right if the pagenumber is odd, left if even *) val floatingfigure: ?label: label -> ?pos: floatingfigure_position -> ?width: size -> ?center: bool -> ?caption: t -> t -> t (** Floating figure which makes text wrap around it. Uses package [floatflt]. Default value for [width] is half the text width. Default value for [center] is false. *) val subfloat: ?label: label -> ?caption: t -> t -> t (** Sub-figure. Uses package [subfig]. Use it inside a [figure] to insert sub-figures. *) (** {3 Miscellaneous Commands} *) val hyphen: t (** Tell LaTeX where to cut words at the end of lines. *) val index: t -> t -> t (** [index x y] produces [{x}_{y}] *) val exponent: t -> t -> t (** [exponent x y] produces [{x}^{y}] *) val index_exponent: t -> t -> t -> t (** [index_exponent x y z] produces [{x}_{y}^{z}]. This is NOT equivalent to [exponent (index x y) z] as this would produce [{{x}_{y}}^{z}]. The former allows the exponent to be printed above the index, while the latter does not. *) val tableofcontents: t val listoffigures: t val listoftables: t val appendix: t (** [printindex] output an index listing the various point which have been referenced by [place_index key]. [key] can be a phrase in which case it appears as-is in the index, or some more complex instruction (documentation for index keys can be found in the Not So Short Introduction to Latex (available online) or the Latex Companion). If you use at least one of [place_index] or [printindex], a file .idx will be produced at the same time as the .aux. It needs to be processed by the program makeindex (makeindex file.idx). Then (pdf)latex needs to be run again. *) val place_index: t -> t val printindex: t val today: t val maketitle: t (** You should not need [maketitle] if you use {!document}. *) val part: ?label: label -> t -> t (** For the report style. *) val chapter: ?label: label -> ?short: t -> t -> t val section: ?label: label -> ?short: t -> t -> t val subsection: ?label: label -> ?short: t -> t -> t val subsubsection: ?label: label -> ?short: t -> t -> t val paragraph: t -> t val chapter': ?label: label -> ?short: t -> t -> t (** Same as [chapter] but with no numbering. *) val section': ?label: label -> ?short: t -> t -> t (** Same as [section] but with no numbering. *) val subsection': ?label: label -> ?short: t -> t -> t (** Same as [subsection] but with no numbering. *) val subsubsection': ?label: label -> ?short: t -> t -> t (** Same as [subsubsection] but with no numbering. *) val par: t val displaymath: t -> t val equation: ?label: label -> t -> t val hfill: t val vfill: t val vfil: t val footnote: t -> t val latex_of_int: int -> t val latex_of_float: float -> t val itemize: t list -> t val enumerate: t list -> t val newline: t (** Start a new line. *) val newline_size: size -> t (** A newline followed by a vertical space. *) val newpage: t (** Start a new page. *) val clearpage: t (** Same as [newpage], but also force figures and tables floating in the current page to be printed. *) val noindent: t val space : t (** Forces a space, same as "\ " in LaTeX *) val quad: t val qquad : t val includegraphics: t -> t val symbol: int -> t val symbolc: char -> t (** Convert a [char] into an [int] and apply [symbol]. *) val center: t -> t val flushleft: t -> t val flushright: t -> t val quote: t -> t val quotation: t -> t val stackrel: t -> t -> t val vspace: size -> t (** A vertical space. *) val hspace: size -> t (** An horizontal, possibly negative space. *) val addvspace: size -> t (** Similar to [vspace], but an [addvspace x] followed by an [addvspace y] will produce an [addvspace] of [max x y]. *) val ignorespaces: t (** Tells LaTeX to ignore following spaces and new lines. Useful at the end of a display environment, for instance. *) val smallskip: t (** A small [vspace]. *) val medskip: t (** A medium [vspace]. *) val bigskip: t (** A big [vspace]. *) val nointerlineskip: t (** Delete the interline vertical space. *) val phantom: t -> t (** Take the space of the argument without actually drawing it *) val vphantom: t -> t (** Vertical-only phantom *) val hphantom: t -> t (** Horizontal-only phantom *) val rule_: ?lift:size -> size -> size -> t (** [rule_ width height] draws a rule (i.e. a black box) of width [width] and height [height] (for instance a horizontal or vertical line). The optional argument [lift] moves the rule up if positive and down if negative. A special case is when [width] is null. In this case the rule, called a strut, does not display, it only makes sure that the surrounding box has at least its height. *) type valignment = [ `T | `C | `B ] (** (`T)op, (`C)enter, (`B)ottom. *) val parbox: size -> ?valign:valignment -> t -> t (** A box in which new lines and paragraphs may be used. Useful to display code listings, for instance. The [valign] optional argument controls the vertical alignment of the box with respect to the surrounding text. *) val minipage: size -> ?valign:valignment -> t -> t (** A box in which almost all command may be used. A more robust kind of [parbox]. *) type halignment = [ `C | `L | `R | `S ] (** (`C)enter, flush (`L)eft, flush (`R)ight or (`S)pread. *) type xsize = [ size | `Width of float | `Height of float | `Depth of float | `Totalheight of float ] (** Horizontal box commands ({!makebox}, {!framebox} and {!raisebox}) can use extra size information in their definition. These are computed from their content: [`Width] is the width of the content [`Height] is the height above the baseline [`Depth] is the height below the baseline [`Totalheight] is the sum of [`Height] and [`Depth] *) val makebox : xsize -> ?halign:halignment -> t -> t (** A box which only deals with horizontaly aligned material. *) val framebox : xsize -> ?halign:halignment -> t -> t (** Same as [makebox] but draws a frame around the box. *) val raisebox : shift:xsize -> ?fakeheight:xsize*xsize -> t -> t (** [raisebox ~shift x] displays x vertically displaced by [shift]. If [~fakeheight] is not specified, then the line is built as if [x] had not been moved. If [~fakeheight:(h,d)] then the line building algorithm sees a box which extends [h] above the baseline (height) and [d] below the baseline (depth). *) type alignment = [ `L | `C | `R ] type array_column = [ alignment | `Vert | `Sep of t] type array_line val array: ?valign:valignment -> array_column list -> array_line list -> t val array_line: ?sep: size -> ?layout:(int*[alignment|`I]) list -> t list -> array_line (** Extra alignment [`I] in layout means that the column inherits the alignment of the first corresponding column in the array layout. The integers in the layout correspond to over how many of the array's column will the cell will span.*) val array_command : t -> array_line (** [array_command x] is a low level command. It gives [x] as an array line to Latex. Meant to define alternative commands to draw horizontal lines in arrays.*) (*spiwack: todo: horizontal line commands, like [hline], [midrule], etc… *) (* Actually, I don't know what these do. *) val frontmatter: t val backmatter: t val mainmatter: t val underbrace: t -> t -> t val overbrace: t -> t -> t (** {3 Fonts} *) (** {4 Font Styles} *) val emph: t -> t (** Emphasize *) val texttt: t -> t (** Monospace *) val textsc: t -> t (** Small caps *) val textit: t -> t (** Italic *) val textbf: t -> t (** Bold *) val textrm: t -> t (** Roman *) val textsf: t -> t (** Sans serif *) val mathit: t -> t (** Italic (for math mode) *) val mathbf: t -> t (** Bold (for math mode) *) val mathrm: t -> t (** Roman (for math mode) *) val mathsf: t -> t (** Sans serif (for math mode) *) val mathcal: t -> t (** Caligraphic *) (** {4 Font Sizes} *) (** From the smallest to the largest. *) val tiny: t -> t val scriptsize: t -> t val footnotesize: t -> t val small: t -> t val normalsize: t -> t val large: t -> t val large2: t -> t val large3: t -> t val huge: t -> t val huge2: t -> t (** {3 Math Accents} *) val hat: t -> t val grave: t -> t val bar: t -> t val acute: t -> t val mathring: t -> t val check: t -> t val dot: t -> t val vec: t -> t val breve: t -> t val tilde: t -> t val ddot: t -> t val widehat: t -> t (** A wide [hat] which spreads over the whole argument. *) val widetilde: t -> t (** A wide [tilde] which spreads over the whole argument. *) val overline: t -> t (** A wide [bar] which spreads over the whole argument. *) (** {3 Greek Letters} *) (** {4 Lowercase} *) val alpha: t val beta: t val gamma: t val delta: t val epsilon: t val varepsilon: t val zeta: t val eta: t val theta: t val vartheta: t val iota: t val kappa: t val varkappa: t val lambda: t val mu: t val nu: t val xi: t val pi: t val varpi: t val rho: t val varrho: t val sigma: t val varsigma: t val tau: t val upsilon: t val phi: t val varphi: t val chi: t val psi: t val omega: t val digamma: t (** {4 Uppercase} *) val gamma_: t val delta_: t val theta_: t val lambda_: t val xi_: t val pi_: t val sigma_: t val upsilon_: t val phi_: t val psi_: t val omega_: t (** {3 Hebrew Letters} *) val aleph: t val beth: t val gimel: t val daleth: t (** {3 Mathematical Symbols} *) (** {4 Binary Relations} *) val le: t (** less or equal *) val leq: t (** less or equal (same as {!le}) *) val leqslant: t (** less or equal (with equal bar parallel to the 'less than' sign *) val ge: t (** greater or equal *) val geq: t (** greater or equal (same as {!ge}) *) val geqslant: t (** greater or equal (with equal bar parallel to the 'less than' sign *) val equiv: t (** = with 3 bars *) val ll: t (** << *) val gg: t (** >> *) val doteq: t (** = with . on top *) val prec: t (** trumpet < *) val succ: t (** trumpet > *) val sim: t (** ~ *) val preceq: t (** trumpet < or equal *) val succeq: t (** trumpet > or equal *) val simeq: t (** ~ or equal *) val subset: t val supset: t val approx: t (** double ~ *) val subseteq: t val supseteq: t val cong: t (** = with ~ on top *) val sqsubset: t (** square strict subset (latexsym package) *) val sqsupset: t (** square strict superset (latexsym package) *) val join_: t (** small bowtie (latexsym package) *) val sqsubseteq: t (** square subset or equal *) val sqsupseteq: t (** square superset or equal *) val bowtie: t val in_: t (** in set *) val owns: t (** inverted in set *) val propto: t (** infinite with open right buckle *) val vdash: t (** |- *) val dashv: t (** -| *) val models: t (** |= *) val mid: t (** | *) val parallel: t (** || *) val perp: t (** _|_ *) val smile: t val frown: t val asymp: t (** frown with smile on top *) val not_: t -> t (** generic negation of binary symbol. [not_ in_] will print as ∉ *) val notin: t (** not in set (∉) *) val ne: t (** not equal (≠)*) val neq: t (** not equal (same as {!ne}) *) (** {4 Binary Operators} *) val pm: t (** - with + on top (∓) *) val mp: t (** + with - on top (±)*) val triangleleft: t (** ◃ *) val cdot: t (** centered . *) val div: t (** - with . on top and . on the bottom (÷)*) val triangleright: t (** ▹ *) val times: t (** × *) val setminus: t (** backslash *) val star: t (** 5-branches star *) val cup: t (** set union *) val cap: t (** set intersection *) val ast: t (** asterisk * (6-branches star) *) val sqcup: t (** square cup *) val sqcap: t (** square cap *) val circ: t (** a small circle *) val lor_: t (** \/ *) val land_: t (** /\ *) val bullet: t (** a small filled circle *) val oplus: t (** a circle with a + inside *) val ominus: t (** a circle with a - inside *) val diamond: t (** a small square rotated 45 degrees *) val odot: t (** a circle with a centered . inside *) val oslash: t (** a slashed circle *) val uplus: t (** a cup with a + inside *) val otimes: t (** a crossed circle *) val bigcirc: t val amalg: t val bigtriangleup: t val bigtriangledown: t val dagger: t val lhd: t (** bigger [triangleleft] (latexsym package) *) val rhd: t (** bigger [triangleright] (latexsym package) *) val ddagger: t (** double dagger ([dagger] with one more cross on the bottom) *) val unlhd: t (** bigger, underlined [triangleleft] (latexsym package) *) val unrhd: t (** bigger, underlined [triangleright] (latexsym package) *) val wr: t (** a vertical ~ *) (** {4 BIG Operators} *) val sum: t val prod: t val coprod: t val bigcup: t val bigcap: t val bigvee: t val bigwedge: t val bigsqcup: t val biguplus: t val int: t val oint: t val bigodot: t val bigoplus: t val bigotimes: t (** {4 Arrows} *) val leftarrow: t (** <- *) val rightarrow: t (** -> *) val to_: t (** -> (same as {!rightarrow}) *) val leftrightarrow: t (** <-> *) val leftarrow_: t (** <= *) val rightarrow_: t (** => *) val leftrightarrow_: t (** <=> *) val longleftarrow: t (** <-- *) val longrightarrow: t (** --> *) val longleftrightarrow: t (** <--> *) val longleftarrow_: t (** <== *) val longrightarrow_: t (** ==> *) val longleftrightarrow_: t (** <==> *) val iff: t (** <==> (bigger spaces) *) val mapsto: t val longmapsto: t val hookleftarrow: t val hookrightarrow: t val leftharpoonup: t val rightharpoonup: t val leftharpoondown: t val rightharpoondown: t val rightleftharpoons: t val uparrow: t val downarrow: t val updownarrow: t val uparrow_: t (** double [uparrow] *) val downarrow_: t (** double [downarrow] *) val updownarrow_: t (** double [updownarrow] *) val nearrow: t (** North-East arrow *) val searrow: t (** South-East arrow *) val swarrow: t (** South-West arrow *) val nwarrow: t (** North-West arrow *) val leadsto: t (** ~> (latexsym package) *) (** {4 Symbols to be Sorted (Stay Tuned)} *) val box_: t (** A square box, for instance to end proofs (QED). Adds package [latexsym]. *) val langle: t (** ⟨ *) val rangle: t (** ⟩ *) val lceil: t (** ⌈ *) val rceil: t (** ⌉ *) val frac: t -> t -> t val land_: t (** /\ *) val lor_: t (** \/ *) val lnot: t (** ¬ *) val neg: t (** ¬ (like {!lnot}) *) val forall: t (** ∀ *) val exists: t (** ∃ *) val top : t (** ⊤ *) val bot : t (** ⊥ *) val sharp : t val dots: t val cdots: t (** Centered dots [...] *) val ldots: t (** elipsis, works in math and text mode *) val emptyset: t type doublable_delimiter = [ `Down | `Up | `Up_down | `Vert ] type delimiter = [ `None | `Brace | `Paren | `Bracket | `Angle | `Floor | `Ceil | `Slash | doublable_delimiter | `Double of doublable_delimiter ] val left: delimiter -> t val right: delimiter -> t val just_left: delimiter -> t -> t (** [just_left d x]: concatenation of [left d], [x] and [right `None]. *) val just_right: delimiter -> t -> t (** [just_right d x]: concatenation of [left `None], [x] and [right d]. *) val between: delimiter -> t -> t (** [between d x]: concatenation of [left d], [x] and [right d]. *) val oe: t (** French e in o as in "coeur", "noeud"... *) (** {4 AMS} *) val mathbb: t -> t val mathfrak: t -> t val align : t -> t (** the AMS align environment to align equations using & *) val align_ : t -> t (** same as [align], but without numbering *) val gather : t -> t val gather_ : t -> t val split : t -> t val proof : ?opt:t -> t -> t val twoheadrightarrow : t (** ->> *) val square: t val par_: t (** The paragraph symbol. *) val black_triangle_left: t val black_triangle_right: t (** {4 Mathpartir} *) val mathpar : t list -> t (** Math paragraph. This function inserts [and] commands between each item to split them. *) val inferrule : ?lab: t -> ?left: t -> ?right: t -> ?vdots: size -> ?width: size -> ?leftskip: size -> ?rightskip: size -> t list -> t list -> t (** Inference rule. [inferrule pre post] builds an inference rule with [pre] at the top and [post] at the bottom. If [pre] or [post] is empty, the bar is not drawn. @param lab label to put above the rule @param left label to put on the left of the rule @param right label to put on the right of the rule @param vdots raise the rule and draw vertical dots ; the length argument is translated to a number of line-skips *) (** {4 Saint Mary Road} *) (** The package ["stmaryrd"] is automatically added by these commands. *) val llbracket: t (** [\[|] *) val rrbracket: t (** [|\]] *) val llparenthesis: t (** [(|] *) val rrparenthesis: t (** [|)] *) (** {3 Slide Document Class} *) val slide: t -> t (** {3 Beamer Document Class} *) module type BEAMER = sig type beamertemplate = [ `NavigationSymbols | `Footline ] type tocoptions = [ `CurrentSection | `CurrentSubsection | `HideAllSubsections | `HideOtherSubsections | `PauseSections | `PauseSubsections ] val frame: ?title: t -> ?subtitle: t -> t -> t (** One slide. *) val setbeamertemplate: beamertemplate -> t -> t val insertpagenumber: t val insertdocumentendpage: t val inserttitle: t val insertsection: t val insertsubsection: t val insertshorttitle: t val insertshortsection: t val insertshortsubsection: t val tableofcontents: tocoptions list -> t val at_begin_section: t -> t val at_begin_subsection: t -> t val at_begin_subsubsection: t -> t val block: t -> t -> t (** [block title body] *) type color = [ | `Gray | `Red | `Green | `Blue | `Yellow | `RGB of float * float * float ] val color: color -> t -> t type overlays_spec = [`I of int] (*val command: ?packages: (string * string) list -> string -> ?only: overlays_spec list -> ?opt: (mode * t) -> (mode * t) list -> mode -> t*) val only: overlays_spec list -> t -> t val includegraphics: ?only: overlays_spec list -> t -> t (** Same as {!Latex.includegraphics} but with the [only] parameter. *) (** {2 Columns} *) type column_alignment = [ `T | `C | `B ] (** Vertical alignment of a column: top, center or bottom. *) val columns: ?align: column_alignment -> t -> t (** Put your columns in this environment. The [align] argument is the default vertical alignment for each column. The last argument must be a concatenation of several {!column}s. *) val column: ?align: column_alignment -> size -> t -> t (** One column. Columns must be put inside the {!columns} environment. *) val equi_columns: ?align: column_alignment -> t list -> t (** Several columns with the same size each. The size of each column is [`Textwidth (1. /. c)] where [c] is the length of the list. The [align]ment is the same for each column. Example with two columns: [equi_columns ["Hello"; "World"]]*) end module Beamer : BEAMER (** {3 Verbatim Modes} *) module Verbatim: sig val verbatim: string -> t (** Replace all non-alphanumerical characters by an application of the [symbol] command, all spaces by escaped spaces, and all new lines by actual new lines. *) val regexps: (Str.regexp * (string -> t)) list -> (string -> t) -> string -> t (** [regexps [r1, a1; r2, a2; ...] f s]: apply [a1] on all matches of [r1] in [s], then [a2] on all matches of [r2], and so on. Note that [r2] is only tested on the parts of [s] which do not match [r1]. [f] is applied on the parts of [s] which are not matched by any of the regular expressions. *) val keywords: ?apply: (t -> t) -> string list -> string -> t (** [keywords k s]: apply [verbatim] on [s] but also apply [~apply] on all keywords given in [k]. The default value of [~apply] is [textbf] (bold font). [keywords ["let"; "in"]] is the same as [regexps [Str.regexp "let\\|in", fun x -> textbf (verbatim x)] verbatim]. *) val pseudocode: ?trim: (string -> string) -> ?id_regexp: Str.regexp -> ?kw_apply: (t -> t) -> ?id_apply: (t -> t) -> ?rem_apply: (string -> t) -> ?keywords: string list -> ?symbols: (string * t) list -> ?keyword_symbols: (string * t) list -> ?underscore: Str.regexp -> string -> t (** Pseudocode parsing. @param trim apply this function first (default is [trim ['\n']]) @param id_regexp the regular expression used to parse identifiers, including keywords (default is words starting with a letter or an underscore followed by any number of letter or digit, followed by any number of groups of underscore followed by at least one letter or digit: [Str.regexp "[_a-zA-Z][a-zA-Z0-9]*\\(_[a-zA-Z0-9]+\\)*"]) @param kw_apply applied to keywords (default is [textbf]) @param id_apply applied to identifiers (default is [mathit]) @param rem_apply applied to remaining parts (default is [verbatim]) @param keywords keyword list @param symbols symbol list and the way they are printed @param keyword_symbols keyword list that should be printed in a special way, as symbols, but parsed as identifiers @param underscore delimiter used to split identifiers (default is underscore (['_'])) Keywords, keyword symbols and identifiers are split using [underscore] as delimiter. The first part is replaced by the corresponding [Latex.t]. The other parts are displayed as indexes separated by commas ([',']). They are also treated as identifiers, potentiel keywords or keyword symbols. *) (** {2 Tools to Build Modes} *) val trim: char list -> string -> string (** Delete characters at the beginning and at the end of a string. [trim [' '; '\n'] s] will return a copy of s without spaces and new lines at the beginning and at the end. *) val trim_begin: char list -> string -> string (** Delete characters at the beginning of a string. [trim [' '; '\n'] s] will return a copy of s without spaces and new lines at the beginning. *) val trim_end: char list -> string -> string (** Delete characters at the end of a string. [trim [' '; '\n'] s] will return a copy of s without spaces and new lines at the end. *) val split_lines: string -> string list (** Split a string according to the ['\n'] delimiter, which is not kept. *) end (** {2 Low-Level LaTeX} *) (** LaTeX mode: math, text or any. *) type mode = M | T | A (** {3 Constructors} *) val empty: t (** The empty LaTeX tree. Equivalent to [concat []] or [text ""]. *) val is_empty: t -> bool (** Test whether a LaTeX tree is empty. A concatenation of empty trees is also empty. A tree containing a {!set} node is not empty. A tree containing {!get} or {!final} nodes is not empty, even if the call will produce an empty tree when evaluating variables. *) (** Raw LaTeX. *) val text: string -> t (** Concatenation. *) val concat: t list -> t (** Infix Concatenation. *) val (^^): t -> t -> t (** LaTeX Command. *) val command: ?packages: (string * string) list -> string -> ?opt: (mode * t) -> (mode * t) list -> mode -> t (** [command name args mode] produces the LaTeX command [name] applied to arguments [args]. The command should be used in mode [mode]. For exemple, the [ensuremath] LaTeX command should be used in math mode. The command will be coerced using [mbox] or [$ ... $] if [mode] differs from the mode it is used in. The [opt] optional parameter may be used to provide an optional parameter (in brackets [[]]) to the LaTeX command. Arguments [opt] and [args] must be given with their expected mode and will be coerced if needed. For example, the [mbox] command expect an argument in text mode (the argument must be coerced using [$ ... $] if it is math). The [ensuremath] command expects an argument in any mode. All packages [(name, opt)] given using [packages] will automatically be used by [document]. *) type arg_kind val bracket : arg_kind val brace : arg_kind val nobr : arg_kind val unusual_command : ?packages: (string * string) list -> string -> (mode * arg_kind * t) list -> mode -> t (** [unusual_command] does the same as [command], but is more low level. Instead of having a single optional argument and a list of mandatory arguments, it only has a list of arguments. Each argument comes not only with its content and mode, but with an "argument kind" (type [arg_kind]) specifying whether it is a brace argument (corresponding to mandatory arguments in [command]) or a bracket argument (corresponding, in turn, to the option argument of [command]). This allows to handle commands which have several optional arguments, or where optional and mandatory arguments are interleaved. *) val within_braces: t -> t (** [within_braces x] produces [{x}]. Typically meant to be used together with [unusual_command]. *) (** LaTeX Environment. *) val environment: ?packages: (string * string) list -> string -> ?opt: (mode * t) -> ?args: (mode * t) list -> (mode * t) -> mode -> t (** Same as function [command], except that it only takes one argument (the environment body) and produces an environment, i.e. using the [begin] and [end] commands. The [args] parameters may be used to give additional arguments, such as the columns of an array. All packages [(name, opt)] given using [packages] will automatically be used by [document]. *) (** Ensure text or math mode. *) val mode: mode -> t -> t (** [mode m x] returns [x] if its mode is already [m]. If its mode is not [m], the result is [x] coerced using [mbox] or [$ ... $]. *) (** {3 Basic blocks to make custom [document] functions} *) val documentclass : ?opt:(mode*t) -> t -> t (** All document must start with a single document class declaration, optionnally with arguments. [documentclass cls] means that [cls] (represented as a [Latex.t]) is the class of the document. The optional argument is given as a [Latex.t] as well, for generality. *) val required_packages : t (** Your prelude must contain the list of packages required by your document. That is a single occurence of [required_packages]. Note that it does not make sense out of the document's prelude. *) val require_packages : (t*t) list -> t (** [require_packages] takes as argument a list of pairs [package,option]. Each [package] is required (see {!packages}) with option [option]. The argument [~packages] of {!document} is implemented as a [require_package]. This command can be used anywhere in a document, if needed. *) val documentmatter : t -> t (** [documentmatter body] renders your actual document, [body], according to the rules specified in the prelude. It is simply LaTeX's [document] command. *) (** {3 Miscellaneous} *) val latex: t (** "LaTeX" written in a fancy but official way. *) val usepackage: ?opt: t -> t -> t (** You can use this in the [~prelude] of your [document], but it is better to use the [~packages] argument of [document]. Note that some commandes add their own packages to the document automatically. *) val input: t -> t (** Include a LaTeX file. Usually you'd prefer to open an OCaml module, but this can be useful if you have a [.tex] file with macros that you want to reuse. *) val newcommand: int -> t -> t -> t (** [newcommand parameter_count name body] defines a new command with [parameter_count] arguments, where you can use the [i]th argument by writing [#i] in the body, just as in Latex. Normally you'd prefer to just define an OCaml value with [let]. *) val renewcommand: int -> t -> t -> t (** Same as [newcommand] except that it can redefine existing LaTeX commands. *) val block: t -> t (** [block x] produces [{x}]. Should only be used in some rare cases when you want to be very precise about what LaTeX should do. If [x] is empty, the braces are not added. If you need braces even if [x] is empty, use {!within_braces}. *) val place_label: label -> t (** [place_label lbl] places label [lbl]. Normally you would prefer using the various [~label] optional arguments available, and only use [place_label] for unimplemented features or if you are feeling hackish. *) val atbegindocument: t -> t val addcontentsline: t -> t -> t -> t (** [addcontentsline toc section name] *) val pagestyle: t -> t val thispagestyle: t -> t val list_insert: 'a -> 'a list -> 'a list (** Inserts an element between each elements of a list. Examples: - [list_insert 1 [] = []] - [list_insert 1 [2] = [2]] - [list_insert 1 [2; 3; 4] = [2; 1; 3; 1; 4]] *) (** {2 Printing} *) type env (* environment used to keep track of the content of variables between multiple applications of to_* functions *) val get_in_env: ?position:position -> 'a variable -> env -> 'a (** All printing functions take the expected mode as a parameter (default is text). The printed expression will be coerced if its mode differs. *) val to_buffer: ?mode: mode -> ?env: env -> Buffer.t -> t -> env val to_channel: ?mode: mode -> ?env: env -> out_channel -> t -> env val to_file: ?mode: mode -> ?env: env -> string -> t -> env val to_string: ?mode: mode -> t -> string val to_string_with_env: ?mode: mode -> ?env: env -> t -> string * env melt-1.4.0/latex/latex.mllib0000644000175000017500000000003411661167412015266 0ustar romainromainPqueue Clist Variable Latex melt-1.4.0/latex/variable.ml0000644000175000017500000002043311661167412015254 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (**** Basic brick: atomic environments. ****) module Int = struct type t = int let compare = compare end module IntSet = Set.Make(Int) module IntMap = Map.Make(Int) module Environment : sig type t val empty : t val new_variable : ?eq:('a -> 'a -> bool) -> 'a -> (t -> 'a -> t) * (t -> 'a) val equal : t -> t -> bool end = struct type t = (bool -> bool) IntMap.t (* Those functions [f] hide a value in their closure. It can be accessed thanks to their side effet. [f true] is true iff the last function called, having the same identifier, holded the same value as [f]. [f false] is true iff f hold the default value. *) let empty = IntMap.empty let new_id = let id = ref 0 in fun () -> incr id; !id let new_variable ?(eq=(=)) default = let id = new_id () in (* reference shared by all variable with the same id *) let v = ref default in (* add in the map [t] a function holding data [x] *) let set t x = let f test_x_equal_default = let old = !v in v := x; if test_x_equal_default then eq x default else eq x old in IntMap.add id f t in (* recover the hidden value *) let get t = ( try ignore ((IntMap.find id t) false) with Not_found -> v := default ); !v in set,get let equal t1 t2 = (* fold returns keys in ascending order so to_list reverse to descending order *) let to_list t = IntMap.fold (fun k x l -> (k,x)::l) t [] in let l1 = to_list t1 in let l2 = to_list t2 in let rec check l1 l2 = match l1,l2 with | [], [] -> true | (k1,f1)::q1,(k2,f2)::q2 when k1 = k2 -> let _ = f1 false in (* now the shared reference [v] holds the value of f1 *) let eq = f2 false in (* f2 checks equality against the shared reference *) if eq then check q1 q2 else false | (k1,f1)::q1,(k2,f2)::q2 when k1 > k2 -> (* keys are in descending order, so k1 > k2 means that l1 has a key that l2 doesn't have *) let eq = f1 true in if eq then check q1 ((k2,f2)::q2) else false | (_,f1)::q1,[] -> let eq = f1 true in if eq then check q1 [] else false | l1,l2 -> check l2 l1 in check l1 l2 end (**** Positions ****) type position = { pos_name : string; pos_id : int } let position : ?name:string -> unit -> position = let id = ref 0 in fun ?name () -> incr id; let name = match name with | None -> "unnamed position " ^ (string_of_int !id) | Some n -> n in { pos_name = name ; pos_id = !id } (**** Variables ****) type 'a t = { set : Environment.t -> 'a -> Environment.t; get : Environment.t -> 'a; equal : 'a -> 'a -> bool; var_name : string; var_printer : 'a -> string } let make ?(eq=(=)) ?(name="unnamed") ?(printer=fun _ -> "undefined printer" ) x = let set,get = Environment.new_variable ~eq x in { set = set; get = get; equal = eq; var_name = name; var_printer = printer } (**** Composed environments ****) type env = { current : Environment.t ; positions : Environment.t IntMap.t ; placed : IntSet.t ; changed : position list ; change_log : position list list ; } let empty = { current = Environment.empty ; positions = IntMap.empty ; placed = IntSet.empty ; changed = [] ; change_log = [] } let at_pos env position = match position with | None -> env.current | Some p -> begin try IntMap.find p.pos_id env.positions with Not_found -> Environment.empty end let get_in_env ?position v env = let lenv = at_pos env position in v.get lenv exception Multiple_place of position let assert_not_placed env position = if IntSet.mem position.pos_id env.placed then raise (Multiple_place position) else { env with placed = IntSet.add position.pos_id env.placed } let place_env env position = let env = assert_not_placed env position in let new_env = env.current in if Environment.equal (at_pos env (Some position)) new_env then env else { env with positions = IntMap.add position.pos_id new_env env.positions; (* TODO récupérer les variables qui ont changé *) changed = position::env.changed } (**** Extending documents ****) type ('a,'b) with_var = | Raw of 'a | Set of (Environment.t -> Environment.t) (* update the environment in the remaining ast. *) | Get of position option * (Environment.t -> 'b) (* Looks for the environment at the given position (current location if it is None) and applies the get function to it. *) | Place of position (* Takes a snapshot of current environment an stores it in the given position. *) let raw x = Raw x let setf var f = Set (fun env -> var.set env (f (var.get env))) let setf2 var1 var2 f = Set (fun env -> var2.set env (f (var1.get env) (var2.get env))) let set var x = setf var (fun _ -> x) let get ?position var k = Get (position , (fun env -> k (var.get env))) let place position = Place position let content = function | Raw y -> Some y | _ -> None (**** Evaluating documents ****) let compute empty encapsulate recurse env = function | Raw x -> encapsulate env x | Set s -> { env with current = s env.current } , empty | Get (p,g) -> recurse env (g (at_pos env p)) | Place p -> place_env env p , empty let reset_env env = { env with placed = IntSet.empty; changed = [] } let log_changes env = { env with change_log = env.changed::env.change_log } exception Fixpoint_divergent of position list list let default_fixpoint_iterations = ref 10 let rec fixpoint ?(env=empty) ?(iterations=(!default_fixpoint_iterations)) f x = if iterations = 0 then raise (Fixpoint_divergent env.change_log) else let (new_env,_) as r = f (reset_env env) x in match new_env.changed with | [] -> r | _ -> let new_env = (* Changes are logged, for error reporting, and the starting current environment is reset. *) { (log_changes new_env) with current = env.current } in fixpoint ~env:new_env ~iterations:(iterations-1) f x (* TODO : control set_default_fixpoint_iterations from a melt option. *) let set_default_fixpoint_iterations n = default_fixpoint_iterations := n melt-1.4.0/latex/variable.mli0000644000175000017500000001216111661167412015424 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (** Type of variables. Variables can be modified during the evaluation of a document. Variables can read current, past and future value, provided this is well-defined. Further documentation can be found in the {!Latex} module. *) type 'a t val make: ?eq:('a -> 'a -> bool) -> ?name:string -> ?printer:('a -> string) -> 'a -> 'a t (** Declare a new variable. The last argument is the default value of the variable. [eq] is the equality function on the type of the variable. Default is [=]. [name] and [printer] are used to print information when the fixpoint calculation diverged. *) (** A position in a document. A variable can read the value it took or will take at a given position. *) type position val position : ?name:string -> unit -> position (** Type of environment giving values to variables. *) type env val empty : env (** Meta-get on environment, expectingly not to be used in document, but rather by document processors. Retrieves the value of a variable at given position. *) val get_in_env : ?position:position -> 'a t -> env -> 'a (** Type of documents extended with variables. *) type ('a,'b) with_var val raw : 'a -> ('a,'b) with_var val setf : 'x t -> ('x->'x) -> ('a,'b) with_var val setf2 : 'x t -> 'y t -> ('x->'y->'y) -> ('a,'b) with_var val set : 'x t -> 'x -> ('a,'b) with_var val get : ?position:position -> 'x t -> ('x -> 'b) -> ('a,'b) with_var val place : position -> ('a,'b) with_var (** [content x] returns [Some y] if [x] is [raw y] and [None] otherwise. *) val content : ('a,'b) with_var -> 'a option (** [computer empty encapsulate recurse env x] computes a value of type ['r] where [empty] is a value of type ['r] (supposedly representing an empty document) used to interpret [set] and [place], [encapsulate] interprets [raw] documents and [recurse] evaluates right-hand sides of [get]. Raises [Multiple_place p] if the position [p] is already placed in [env] and [place p] is evaluated.*) exception Multiple_place of position val compute : 'r -> (env->'a -> env*'r) -> (env->'b -> env*'r) -> env -> ('a,'b) with_var -> env * 'r (** [fixpoint env iterations f x] iterates [fun e -> fst (f e x)] starting on [env] until a fixpoint is reached or [iterations] iterations have been done. In the latter case it fails with [Fixpoint_divergent log]. In the former, let [e0] be the fixpoint, the return value is then [f e0 x]. The "current position" is reset with every iteration, so that the fixpoint effectively computed is only about snapshots at positions. By default, the starting environement is {!empty}. The default value for [iterations] is given by {!set_default_fixpoint_iterations}. The starting value being 10. *) exception Fixpoint_divergent of position list list val fixpoint : ?env:env -> ?iterations:int -> (env -> 'a -> env * 'b) -> 'a -> env * 'b val set_default_fixpoint_iterations : int -> unit melt-1.4.0/latex/latex.ml0000644000175000017500000014717111661167412014615 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Printf (* Use this to report errors. *) let error x = ksprintf failwith x module Opt = struct let iter f = function | Some x -> f x | None -> () let map f = function | Some x -> Some (f x) | None -> None let default d = function | Some x -> x | None -> d let cons ox l = match ox with | Some x -> x::l | None -> l let fold f a = function | Some x -> f a x | None -> a let is_none = function | None -> true | Some _ -> false end type mode = M | T | A type arg_kind = Bracket | Brace | NoBr let bracket = Bracket let brace = Brace let nobr = NoBr type 'r elt = | Command of string * (mode * arg_kind * 'r) list * mode | Text of string | Environment of string * (mode * 'r) option * (mode * 'r) list * (mode * 'r) * mode | Mode of mode * 'r type t = X of (t elt,t) Variable.with_var Clist.t type raw = R of raw elt Clist.t let unX = function X l -> l let concat l = X (Clist.list_concat (List.map unX l)) let empty = X (Clist.empty) let of_elt e = X (Clist.singleton e) (******************************************************************************) (* Variables *) (******************************************************************************) type 'a variable = 'a Variable.t type position = Variable.position type env = Variable.env let variable = Variable.make let position = Variable.position let get_in_env = Variable.get_in_env (* spiwack: this function is mostly implied by its types. we could lower the apparent complexity by having a few combinators on the state monad. *) let compute_elt : ('e->'r->'e*'k) -> 'e -> 'r elt -> 'e*'k elt = fun m env -> function | Command (s, l , mode) -> let env,l = let aux (env,l) (mode,kind,t) = let (env,t) = m env t in (env,(mode,kind,t)::l) in List.fold_left aux (env,[]) l in env , Command (s, List.rev l, mode) | Mode (mode, t) -> let env,t = m env t in env , Mode (mode, t) | Environment (s , opt, l, (mode, t), mode') -> (* l'ordre d'évaluation est gratuit, je ne sais pas si c'est le bon *) let env , opt = match opt with | None -> env,None | Some (mode,t) -> let env,t = m env t in env,Some (mode,t) in let env,l = let aux (env,l) (mode,t) = let (env,t) = m env t in (env,(mode,t)::l) in List.fold_left aux (env,[]) l in let env,t = m env t in env , Environment (s, opt, List.rev l, (mode, t), mode' ) | Text s -> env , Text s let rec compute_clist : ('e->'a->'e*'k Clist.t) -> 'e -> 'a Clist.t -> 'e*'k Clist.t = fun m env l -> if Clist.is_empty l then env, Clist.empty else let (env,x) = m env (Clist.head l) in let (env,q) = compute_clist m env (Clist.tail l) in env , Clist.app x q let rec compute : Variable.env -> t -> (Variable.env*raw) = fun env x -> let (env,l) = compute_clist2 env x in env , R l and compute_clist2 : Variable.env -> t -> (Variable.env*raw elt Clist.t) = fun env x -> compute_clist begin fun (env:Variable.env) (xelt:(t elt,t) Variable.with_var) -> Variable.compute Clist.empty compute_of_elt compute_clist2 env xelt end env (unX x) and compute_of_elt : Variable.env -> t elt -> (Variable.env*raw elt Clist.t) = fun env elt -> let (env,elt) = compute_elt compute env elt in (env,Clist.singleton elt) let fixpoint ?env ?iterations x = Variable.fixpoint compute ?env ?iterations x let setf var f = of_elt (Variable.setf var f) let setf2 var1 var2 f = of_elt (Variable.setf2 var1 var2 f) let get ?position var f = of_elt (Variable.get ?position var f) let place position = of_elt (Variable.place position) let set var x = of_elt (Variable.set var x) let incr_var x = setf x (fun x -> x + 1) let decr_var x = setf x (fun x -> x - 1) let text s = of_elt (Variable.raw (Text s)) let vari x = get x (fun v -> text (string_of_int v)) let varf x = get x (fun v -> text (string_of_float v)) let varb x = get x (fun v -> text (string_of_bool v)) let vars x = get x text let vart x = get x (fun v -> v) let finalpos = position ~name:"final position" () let final var f = get ~position:finalpos var f let finali x = final x (fun v -> text (string_of_int v)) let finalf x = final x (fun v -> text (string_of_float v)) let finalb x = final x (fun v -> text (string_of_bool v)) let finals x = final x text let finalt x = final x (fun v -> v) (******************************************************************************) (* Packages and Commands *) (******************************************************************************) module PackageSet = Set.Make(struct type u = t * t type t = u let compare = compare end) let package_collector = let printer _ = (* TODO: il faudrait que to_string soit déclaré avant ca pour faire un printer *) "still to be written" in variable ~eq:PackageSet.equal ~name:"package collector" ~printer PackageSet.empty let require_package acc package = concat [ setf package_collector (PackageSet.add package); acc; ] let require_packages packages = List.fold_left require_package empty packages let require_package_string acc (a, b) = require_package acc (text a, text b) let unusual_command ?(packages = []) name args mode = let thecommand = of_elt (Variable.raw (Command (name, args, mode))) in List.fold_left require_package_string thecommand packages let command ?(packages=[]) name ?opt args mode = let opt = Opt.map (fun (m,t) -> (m,Bracket,t)) opt in let args = List.map (fun (m,t) -> (m,Brace,t)) args in let args = Opt.cons opt args in unusual_command ~packages name args mode let environment ?(packages = []) name ?opt ?(args = []) body mode = let theenvironment = of_elt (Variable.raw (Environment(name, opt, args, body, mode))) in List.fold_left require_package_string theenvironment packages let (^^) x y = X (Clist.app (unX x) (unX y)) let mode mode x = of_elt (Variable.raw (Mode(mode, x))) let latex = command "LaTeX" [] T let usepackage ?opt name = let opt = Opt.map (fun x -> T, x) opt in command "usepackage" ?opt [T, name] T ^^ text"\n" let final_usepackages = get ~position:finalpos package_collector (fun pc -> concat (PackageSet.fold (fun (name, opt) acc -> usepackage ~opt name :: acc) pc [])) (******************************************************************************) module Pp: sig type t val make: Buffer.t -> t val string: t -> string -> unit val char: t -> char -> unit val newline: ?force: bool -> t -> unit val bol: t -> unit (* new line if not already at a new line *) val indent: t -> int -> unit (* relative indentation of the next line *) val space: t -> unit (* space if not already after a space *) end = struct type t = { buf: Buffer.t; mutable bol: bool; mutable alinea: string; mutable indent: int; mutable last_char: char; mutable line_empty: bool; } let output_char x c = Buffer.add_char x.buf c; x.last_char <- c; if c <> ' ' then x.line_empty <- false let newline ?(force = false) x = if force || not x.line_empty then begin output_char x '\n'; x.bol <- true; x.line_empty <- true end let bol x = if not x.bol then newline x let output_string x s = if String.length s <> 0 then begin Buffer.add_string x.buf s; x.last_char <- s.[String.length s - 1] end; let empty = ref true in begin try for i = 0 to String.length s - 1 do if s.[i] <> ' ' then begin empty := false; raise Not_found end done with Not_found -> () end; x.line_empty <- x.line_empty && !empty let make buf = { buf = buf; bol = true; alinea = ""; indent = 0; last_char = ' '; line_empty = true; } let force_alinea x = if x.bol then output_string x x.alinea; x.bol <- false let string x s = let s = Str.full_split (Str.regexp"\n\\|\r") s in List.iter begin function | Str.Delim "\n" (* -> newline ~force:true x*) | Str.Delim "\r" -> newline (*~force:false*) x | Str.Delim _ -> assert false | Str.Text l -> force_alinea x;output_string x l end s let char x c = force_alinea x; output_char x c let indent x i = x.indent <- x.indent + i; x.alinea <- if x.indent <= 0 then "" else String.make x.indent ' ' let space x = if x.last_char <> ' ' then begin output_char x ' '; x.last_char <- ' ' end end let ensure_mode pp from_mode to_mode f = match from_mode, to_mode with | M, M | T, T | A, _ | _, A -> f () | M, T -> Pp.char pp '$'; f (); Pp.char pp '$' | T, M -> Pp.string pp "\\mbox{"; f (); Pp.char pp '}' (* [par] is defined here because it has a special use in the prelude. *) let partext = "\r%\n\\par\n%\n" let par = text partext (* bol: "beginning of line" *) let rec out_elt toplevel mode pp = function | Text x when toplevel && x = partext -> Pp.bol pp; Pp.newline ~force: true pp | Command(name, args, rm) -> ensure_mode pp rm mode begin fun () -> if args = [] && mode = T then Pp.char pp '{'; Pp.char pp '\\'; Pp.string pp name; if args = [] && mode = M then Pp.space pp; if args = [] && mode = T then Pp.char pp '}'; out_args pp args end | Environment(name, opt, args, (bodymode, body), rm) -> ensure_mode pp rm mode begin fun () -> Pp.bol pp; Pp.string pp "\\begin{"; Pp.string pp name; Pp.char pp '}'; Opt.iter (command_argument_brackets pp) opt; List.iter (command_argument_braces pp) args; Pp.indent pp 2; Pp.bol pp; out true bodymode pp body; Pp.indent pp (-2); Pp.bol pp; Pp.string pp "\\end{"; Pp.string pp name; Pp.char pp '}'; Pp.bol pp end | Text s -> Pp.string pp s | Mode(m, x) -> ensure_mode pp m mode (fun () -> out false m pp x) and out toplevel mode pp (R x) = Clist.iter (out_elt toplevel mode pp) x and command_argument pp (mode, x) before after = Pp.string pp before; out false mode pp x; Pp.string pp after and command_argument_braces pp ca = command_argument pp ca "{" "}" and command_argument_brackets pp ca = command_argument pp ca "[" "]" and command_argument_nobr pp ca = command_argument pp ca " " "" and out_args = let out_arg pp = function | (m,Bracket,t) -> command_argument_brackets pp (m,t) | (m,Brace,t) -> command_argument_braces pp (m,t) | (m,NoBr,t) -> command_argument_nobr pp (m,t) in fun pp args -> List.iter (out_arg pp) args let to_buffer ?(mode = T) ?env buf x = let env,x = (fixpoint ?env (concat [x;place finalpos])) in out true mode (Pp.make buf) x; env let to_channel ?mode ?env c x = let buf = Buffer.create 69 in let env = to_buffer ?env ?mode buf x in Buffer.output_buffer c buf; env let to_file ?mode ?env f x = let oc = open_out f in let env = to_channel ?env ?mode oc x in close_out oc; env let to_string_with_env ?mode ?env x = let buf = Buffer.create 69 in let env = to_buffer ?env ?mode buf x in Buffer.contents buf, env let to_string ?mode x = fst (to_string_with_env ?mode x) (*******************************************************************************) let list_insert sep = function | [] | [_] as x -> x | x::rem -> List.flatten ([x]::(List.map (fun x -> [sep; x]) rem)) let rec list_filter_options acc = function | [] -> List.rev acc | None :: rem -> list_filter_options acc rem | Some x :: rem -> list_filter_options (x :: acc) rem let list_filter_options = list_filter_options [] let make_option ?(sep = ",") mode f o = if o = [] then None else let o = list_insert (text sep) (List.map (fun x -> text x) (List.map f o)) in Some(mode, concat o) type size = [ | `In of float | `Mm of float | `Cm of float | `Pt of float | `Em of float | `Ex of float | `Pc of float | `Bp of float | `Dd of float | `Cc of float | `Sp of float | `Parindent of float | `Baselineskip of float | `Baselinestretch of float | `Parskip of float | `Textwidth of float | `Linewidth of float | `Textheight of float | `Unitlength of float | `Fill | `Stretch of int ] let string_of_size size = match size with | `In x -> sprintf "%fin" x | `Mm x -> sprintf "%fmm" x | `Cm x -> sprintf "%fcm" x | `Pt x -> sprintf "%fpt" x | `Em x -> sprintf "%fem" x | `Ex x -> sprintf "%fex" x | `Pc x -> sprintf "%fpc" x | `Bp x -> sprintf "%fbp" x | `Dd x -> sprintf "%fdd" x | `Cc x -> sprintf "%fcc" x | `Sp x -> sprintf "%fsp" x | `Parindent x -> sprintf "%f\\parindent" x | `Baselineskip x -> sprintf "%f\\baselineskip" x | `Baselinestretch x -> sprintf "%f\\baselinestretch" x | `Parskip x -> sprintf "%f\\parskip" x | `Textwidth x -> sprintf "%f\\textwidth" x | `Linewidth x -> sprintf "%f\\linewidth" x | `Textheight x -> sprintf "%f\\textheight" x | `Unitlength x -> sprintf "%f\\unitlength" x | `Fill -> sprintf "\\fill" | `Stretch x -> sprintf "\\stretch{%i}" x let latex_of_size size = text (string_of_size size) let latex_of_int x = text (string_of_int x) let latex_of_float x = text (string_of_float x) let rec is_empty_elt x = match Variable.content x with | Some (Text "") -> true | Some (Mode(_, y)) -> is_empty y | Some (Command _ | Environment _ | Text _) | None -> (* When the AST is built, we are working with variables. *) false and is_empty x = Clist.forall is_empty_elt (unX x) let none_if_empty x = if is_empty x then None else Some x let optcmd name = function | Some arg -> command name [T, arg] T | None -> empty let labelo l = optcmd "label" (Opt.map text l) (*******************************************************************************) type label = string let label = let cnt = ref 0 in fun ?name () -> match name with | None -> incr cnt; "latex_lib_label_" ^ string_of_int !cnt | Some name -> name let ref_ l = command "ref" [T, text l] T let place_label l = command "label" [T, text l] T (******************************************************************************) (* Index construction *) let needs_indexing = variable ~name:"needs indexing" ~printer:string_of_bool false let place_index key = concat [set needs_indexing true; (command "index" ~packages:["makeidx",""] [T,key] T)] let printindex = concat [set needs_indexing true; (command "printindex" ~packages:["makeidx",""] [] T)] let start_indexing = get ~position:finalpos needs_indexing begin function | true -> text "\\makeindex" | false -> empty end (******************************************************************************) type documentclass = [ `Article | `Report | `Book | `Letter | `Slides | `Beamer | `Custom of string ] type documentoptions = [ `Landscape | `A4paper | `TwoColumn | `Pt of int ] let input file = command "input" [T,file] T let newcommand count name body = command "newcommand" ?opt: (if count = 0 then None else Some(T, latex_of_int count)) [T, name; T, body] T let renewcommand count name body = command "renewcommand" ?opt: (if count = 0 then None else Some(T, latex_of_int count)) [T, name; T, body] T let required_packages = concat [ final_usepackages ; par; start_indexing; ] let documentclass ?opt cl = command "documentclass" ?opt [T,cl] T let documentmatter x = environment "document" (T, x) T (* to be able to use a [documentclass] label *) let _documentclass = documentclass let document ?(documentclass=`Article) ?(options=[]) ?title ?author ?date ?(prelude=empty) ?(packages=[]) body = let dc = match documentclass with | `Article -> "article" | `Report -> "report" | `Book -> "book" | `Letter -> "letter" | `Slides -> "slides" | `Beamer -> "beamer" | `Custom c -> c in let options = make_option T begin function | `Landscape -> "landscape" | `A4paper -> "a4paper" | `TwoColumn -> "twocolumn" | `Pt i -> (string_of_int i)^"pt" end options in let body = if title <> None then command "maketitle" [] T ^^ body else body in concat [ _documentclass ?opt:options (text dc); par; require_packages packages; required_packages; par; prelude; par; optcmd "title" title; text"\n"; optcmd "author" author; text"\n"; optcmd "date" date; text"\n"; par; documentmatter body; ] let within_braces x = text "{" ^^ x ^^ text "}" let block x = match none_if_empty x with | None -> empty | Some x -> within_braces x let index x y = mode M (block x ^^ text "_" ^^ block y) let exponent x y = mode M (block x ^^ text "^" ^^ block y) let index_exponent x y z = mode M (block x ^^ text "_" ^^ block y ^^ text "^" ^^ block z) let part ?label title = command "part" [T, title] T ^^ labelo label let section_command name numbered ?label ?short title = let opt = match short with | Some short -> Some (T, short) | None -> None in command (if numbered then name else name ^ "*") ?opt [T, title] T ^^ labelo label let chapter = section_command "chapter" true let section = section_command "section" true let subsection = section_command "subsection" true let subsubsection = section_command "subsubsection" true let paragraph title = command "paragraph" [T, title] T let chapter' = section_command "chapter" false let section' = section_command "section" false let subsection' = section_command "subsection" false let subsubsection' = section_command "subsubsection" false let displaymath x = environment "displaymath" (M, x) T let equation ?label x = environment "equation" (M, labelo label ^^ x) T let emph x = command "emph" [T, x] T let today = command "today" [] T let maketitle = command "maketitle" [] T let texttt x = command "texttt" [T, x] T let textsc x = command "textsc" [T, x] T let textit x = command "textit" [T, x] T let textbf x = command "textbf" [T, x] T let textrm x = command "textrm" [T, x] T let textsf x = command "textsf" [T, x] T let mathit x = command "mathit" [M, x] M let mathbf x = command "mathbf" [M, x] M let mathcal x = command "mathcal" [M, x] M let mathsf t = command "mathsf" [M,t] M let tiny x = block (command "tiny" [T, x] T) let scriptsize x = block (command "scriptsize" [T, x] T) let footnotesize x = block (command "footnotesize" [T, x] T) let small x = block (command "small" [T, x] T) let normalsize x = block (command "normalsize" [T, x] T) let large x = block (command "large" [T, x] T) let large2 x = block (command "Large" [T, x] T) let large3 x = block (command "LARGE" [T, x] T) let huge x = block (command "huge" [T, x] T) let huge2 x = block (command "Huge" [T, x] T) let hfill = command "hfill" [] T let footnote x = command "footnote" [T, x] T let tableofcontents = command "tableofcontents" [] T let listoffigures = command "listoffigures" [] T let listoftables = command "listoftables" [] T type alignment = [ `L | `C | `R ] type array_column = [ alignment | `Vert | `Sep of t] type array_line_normal = { al_columns: (int*[alignment | `I]*t) list; al_sep: size option; } type array_line = | ArrayNormal of array_line_normal | ArrayCommand of t let array_line ?sep ?layout xs = let xs = match layout with | None -> List.map (fun x -> (1,`I,x)) xs | Some l -> try List.map2 (fun x (i,a) -> (i,a,x)) xs l with Invalid_argument _ -> error "array_line: %d columns but layout only supports %d." (List.length xs) (List.length l) in ArrayNormal { al_columns = xs; al_sep = sep } let array_command x = ArrayCommand x let array_line_width al = List.fold_left (fun acc (w,_,_) -> acc+w) 0 al.al_columns let array_line_mapi f al = let rec array_line_mapi al i = match al with | [] -> [] | (w,_,_) as x :: l -> (f i x)::(array_line_mapi l (i+w)) in array_line_mapi al.al_columns 0 let newline = text "\\\\\n" let newline_size x = text (Printf.sprintf "\\\\[%s]\n" (string_of_size x)) let newpage = text"\r%\n%\n\\newpage\n%\n%\n" let clearpage = command "clearpage" [] T let newlinegen = function | None -> newline | Some x -> newline_size x let space = command " " [] A let quad = command "quad" [] M let qquad = command "qquad" [] M let includegraphics filename = command ~packages: ["graphicx", ""] "includegraphics" [ A, filename ] T let symbol i = command "symbol" [T, latex_of_int i] T let symbolc c = symbol (Char.code c) type float_position = [ `H | `T | `P | `B | `Force ] let float_all = [ `H; `T; `B; `P ] let generic_figure_contents ?label ?(center = false) ?caption body = let body = if center then text "\\centering{}" ^^ body else body in let body = match caption with | None -> body | Some caption -> body ^^ command "caption" [T, caption] T in let body = body ^^ labelo label in body let figure ?label ?(pos = [ `H ]) ?center ?(side_caption = false) ?caption ?(wide = false) body = let spos = String.concat "" begin List.map begin function | `H -> "h" | `T -> "t" | `P -> "p" | `B -> "b" | `Force -> "!" end pos end in let body = generic_figure_contents ?label ?center ?caption body in let name = match side_caption, wide with | false, false -> "figure" | true, false -> "SCfigure" | false, true -> "figure*" | true, true -> "SCfigure*" in let packages = if side_caption then [ "sidecap", "" ] else [] in let packages = if wide && List.mem `B pos then ("stfloats", "") :: packages else packages in environment ~packages ~opt: (A, text spos) name (T, body) T type wrapfigure_position = [ `L | `R | `I | `O | `Force of [ `L | `R | `I | `O ] ] let wrapfigure ?label ?(pos: wrapfigure_position = `R) ?lines ?(width: size = `Textwidth 0.5) ?center ?caption body = let pos = match pos with | `L -> "L" | `R -> "R" | `I -> "I" | `O -> "O" | `Force `L -> "l" | `Force `R -> "r" | `Force `I -> "i" | `Force `O -> "o" in let body = generic_figure_contents ?label ?center ?caption body in let opt = Opt.map (fun i -> A, latex_of_int i) lines in environment ?opt ~packages: [ "wrapfig", "" ] ~args: [A, text pos; A, latex_of_size width] "wrapfigure" (T, body) T type floatingfigure_position = [ `L | `R | `P ] let floatingfigure ?label ?(pos: floatingfigure_position = `R) ?(width: size = `Textwidth 0.5) ?center ?caption body = let pos = match pos with | `R -> "r" | `L -> "l" | `P -> "p" in let body = generic_figure_contents ?label ?center ?caption body in environment ~opt: (A, text pos) ~packages: [ "floatflt", "" ] ~args: [A, latex_of_size width] "floatingfigure" (T, body) T let subfloat ?label ?caption body = let opt = Opt.map (fun c -> T, c) caption in let body = labelo label ^^ body in environment ?opt ~packages: [ "subfig", "" ] "subfloat" (T, body) T let center x = environment "center" (T, x) T let flushleft x = environment "flushleft" (T,x) T let flushright x = environment "flushright" (T,x) T let latex_of_array_column = function | `L -> text "l" | `C -> text "c" | `R -> text "r" | `Vert -> text "|" | `Sep t -> concat [ text "@{" ; t ; text "}"] let multicolumn w a x = command "multicolumn" [(A,latex_of_int w); (A,latex_of_array_column a); (M,x)] A type valignment = [ `T | `C | `B ] let latex_of_valignment = function | `T -> text "t" | `C -> text "c" | `B -> text "b" let array ?valign c l = let cols = concat begin List.map latex_of_array_column c end in let alignments = Array.of_list (List.filter (function #alignment -> true | _ -> false) c) in let numcols = Array.length alignments in let multicolumn i (w,a,x)= match a with | `I -> if w = 1 then (*spiwack: do we need to take care of cases <1? *) x else multicolumn w (alignments.(i)) x | #array_column as a -> multicolumn w a x in let lines = List.map begin fun al -> match al with | ArrayNormal al -> begin let width = array_line_width al in if width <> numcols then error "array: line with %d columns instead of %d" width numcols; let lc = array_line_mapi multicolumn al in concat (list_insert (text " & ") lc) ^^ newlinegen al.al_sep end | ArrayCommand x -> x ^^ text"\n" end l in let body = concat lines (*(list_insert newline lines)*) in let opt = Opt.map (fun a -> A,latex_of_valignment a) valign in environment "array" ?opt ~args: [M, cols] (M, body) M let list_env l name = (* let items = List.map ((^^) (command "item" [] T)) l in*) (* Latex produces an error with empty itemize or enumerate. We might as well produce the error ourself. *) if l = [] then error "itemize or enumerate: no item given"; let items = List.map ((^^) (text "\\item ")) l in let body = concat (list_insert (text "\n") items) in environment name (T, body) T let itemize l = list_env l "itemize" let enumerate l = list_env l "enumerate" let vspace s = command "vspace" [T, latex_of_size s] T let hspace s = command "hspace" [T, latex_of_size s] T let addvspace s = command "addvspace" [T, latex_of_size s] T let ignorespaces = text "\\ignorespaces " (* ignorespaces must not have any braces, so we use the raw [text] function *) let smallskip = command "smallskip" [] T let medskip = command "medskip" [] T let bigskip = command "bigskip" [] T let nointerlineskip = command "nointerlineskip" [] T let phantom x = command "phantom" [T, x] T let vphantom x = command "vphantom" [T, x] T let hphantom x = command "hphantom" [T, x] T let rule_ ?lift width height = let width = latex_of_size width in let height = latex_of_size height in let opt = Opt.map (fun l->A,latex_of_size l) lift in command "rule" ?opt [A,width;A,height] A let parbox x ?valign y = let opt = Opt.map (fun v -> A,latex_of_valignment v) valign in command "parbox" ?opt [A, latex_of_size x; T, y] T let minipage size ?valign x = let opt = Opt.map (fun v -> A,latex_of_valignment v) valign in let args = [A,latex_of_size size] in environment "minipage" ?opt ~args (T,x) T type halignment = [ `C | `L | `R | `S ] let latex_of_halignment = function | `C -> text "c" | `L -> text "l" | `R -> text "r" | `S -> text "s" type xsize = [ size | `Width of float | `Height of float | `Depth of float | `Totalheight of float ] (** Horizontal box commands ({!makebox}, {!framebox} and {!raisebox}) can use extra size information in their definition. These are computed from their content: [`Width] is the width of the content [`Height] is the height above the baseline [`Depth] is the height below the baseline [`Totalheight] is the sum of [`Height] and [`Depth] *) let string_of_xsize = function | `Width x -> sprintf "%f\\width" x | `Height x -> sprintf "%f\\height" x | `Depth x -> sprintf "%f\\depth" x | `Totalheight x -> sprintf "%f\\totalheight" x | #size as s -> string_of_size s let latex_of_xsize s = text(string_of_xsize s) let makeframebox name size ?halign t = let size = (A, bracket,latex_of_xsize size) in let halign = Opt.map (fun h -> (A,bracket,latex_of_halignment h)) halign in let t = (T,brace,t) in unusual_command name (size::(Opt.cons halign [t])) T let makebox = makeframebox "makebox" let framebox = makeframebox "framebox" let raisebox ~shift ?fakeheight x = let shift = (A,brace,latex_of_xsize shift) in let opt s = (A,bracket,latex_of_xsize s) in let fakeh = Opt.map (fun (h,_) -> opt h) fakeheight in let faked = Opt.map (fun (_,d) -> opt d) fakeheight in let x = (T,brace,x) in unusual_command "raisebox" (shift::(Opt.cons fakeh (Opt.cons faked [x]))) T let noindent = command "noindent" [] T let stackrel x y = command "stackrel" [M, x; M, y] M (*******************************************************************************) let box_ = command ~packages: [ "latexsym", "" ] "Box" [] M let langle = command "langle" [] M let rangle = command "rangle" [] M let lceil = command "lceil" [] M let rceil = command "rceil" [] M let frac x y = command "frac" [M, x; M, y] M let land_ = command "land" [] M let lor_ = command "lor" [] M let lnot = command "lnot" [] M let forall = command "forall" [] M let exists = command "exists" [] M let top = command "top" [] M let bot = command "bot" [] M let cdots = command "cdots" [] M let sharp =command "sharp" [] M let emptyset = command "emptyset" [] M type doublable_delimiter = [ `Down | `Up | `Up_down | `Vert ] type delimiter = [ `None | `Brace | `Paren | `Bracket | `Angle | `Floor | `Ceil | `Slash | doublable_delimiter | `Double of doublable_delimiter ] let ambidexter_delimiter_to_text = function | `Down -> "\\downarrow" | `Up -> "\\uparrow" | `Up_down -> "\\updownarrow" | `Vert -> "|" | `Double `Down -> "\\Downarrow" | `Double `Up -> "\\Uparrow" | `Double `Up_down -> "\\Updownarrow" | `Double `Vert -> "\\|" let delimiter_to_left_text: delimiter -> string = function | `None -> "." | `Brace -> "\\{" | `Paren -> "(" | `Bracket -> "[" | `Angle -> "\\langle" | `Floor -> "\\lfloor" | `Ceil -> "\\lceil" | `Slash -> "/" | `Down | `Up | `Up_down | `Vert | `Double _ as x -> ambidexter_delimiter_to_text x let delimiter_to_right_text = function | `None -> "." | `Brace -> "\\}" | `Paren -> ")" | `Bracket -> "]" | `Angle -> "\\rangle" | `Floor -> "\\rfloor" | `Ceil -> "\\rceil" | `Slash -> "\\backslash" | `Down | `Up | `Up_down | `Vert | `Double _ as x -> ambidexter_delimiter_to_text x let left d = command (sprintf "left%s" (delimiter_to_left_text d)) [] M let right d = command (sprintf "right%s" (delimiter_to_right_text d)) [] M let just_left d x = mode M (concat [left d; x; right `None]) let just_right d x = mode M (concat [left `None; x; right d]) let between d x = mode M (concat [left d; x; right d]) let oe = command "oe" [] T (*******************************************************************************) let hat x = command "hat" [M, x] M let grave x = command "grave" [M, x] M let bar x = command "bar" [M, x] M let acute x = command "acute" [M, x] M let mathring x = command "mathring" [M, x] M let check x = command "check" [M, x] M let dot x = command "dot" [M, x] M let vec x = command "vec" [M, x] M let breve x = command "breve" [M, x] M let tilde x = command "tilde" [M, x] M let ddot x = command "ddot" [M, x] M let widehat x = command "widehat" [M, x] M let widetilde x = command "widetilde" [M, x] M let overline x = command "overline" [M, x] M (*******************************************************************************) let alpha = command "alpha" [] M let beta = command "beta" [] M let gamma = command "gamma" [] M let delta = command "delta" [] M let epsilon = command "epsilon" [] M let varepsilon = command "varepsilon" [] M let zeta = command "zeta" [] M let eta = command "eta" [] M let theta = command "theta" [] M let vartheta = command "vartheta" [] M let iota = command "iota" [] M let kappa = command "kappa" [] M let varkappa = command "varkappa" ~packages:["amssymb",""] [] M let lambda = command "lambda" [] M let mu = command "mu" [] M let nu = command "nu" [] M let xi = command "xi" [] M let pi = command "pi" [] M let varpi = command "varpi" [] M let rho = command "rho" [] M let varrho = command "varrho" [] M let sigma = command "sigma" [] M let varsigma = command "varsigma" [] M let tau = command "tau" [] M let upsilon = command "upsilon" [] M let phi = command "phi" [] M let varphi = command "varphi" [] M let chi = command "chi" [] M let psi = command "psi" [] M let omega = command "omega" [] M let digamma = command "digamma" ~packages:["amssymb",""] [] M let gamma_ = command "Gamma" [] M let delta_ = command "Delta" [] M let theta_ = command "Theta" [] M let lambda_ = command "Lambda" [] M let xi_ = command "Xi" [] M let pi_ = command "Pi" [] M let sigma_ = command "Sigma" [] M let upsilon_ = command "Upsilon" [] M let phi_ = command "Phi" [] M let psi_ = command "Psi" [] M let omega_ = command "Omega" [] M let aleph = command "aleph" [] M let beth = command "beth" ~packages:["amssymb",""] [] M let gimel = command "gimel" ~packages:["amssymb",""] [] M let daleth = command "daleth" ~packages:["amssymb",""] [] M (*******************************************************************************) let le = command "le" [] M let ge = command "ge" [] M let leqslant = command "leqslant" ~packages:["amssymb",""] [] M let geqslant = command "geqslant" ~packages:["amssymb",""] [] M let equiv = command "equiv" [] M let ll = command "ll" [] M let gg = command "gg" [] M let doteq = command "doteq" [] M let prec = command "prec" [] M let succ = command "succ" [] M let sim = command "sim" [] M let preceq = command "preceq" [] M let succeq = command "succeq" [] M let simeq = command "simeq" [] M let subset = command "subset" [] M let supset = command "supset" [] M let approx = command "approx" [] M let subseteq = command "subseteq" [] M let supseteq = command "supseteq" [] M let cong = command "cong" [] M let sqsubset = command "sqsubset" [] M let sqsupset = command "sqsupset" [] M let join_ = command "Join" [] M let sqsubseteq = command "sqsubseteq" [] M let sqsupseteq = command "sqsupseteq" [] M let bowtie = command "bowtie" [] M let in_ = command "in" [] M let owns = command "owns" [] M let propto = command "propto" [] M let vdash = command "vdash" [] M let dashv = command "dashv" [] M let models = command "models" [] M let mid = command "mid" [] M let parallel = command "parallel" [] M let perp = command "perp" [] M let smile = command "smile" [] M let frown = command "frown" [] M let asymp = command "asymp" [] M let notin = command "notin" [] M let ne = command "ne" [] M (*******************************************************************************) let pm = command "pm" [] M let mp = command "mp" [] M let triangleleft = command "triangleleft" [] M let cdot = command "cdot" [] M let div = command "div" [] M let triangleright = command "triangleright" [] M let times = command "times" [] M let setminus = command "setminus" [] M let star = command "star" [] M let cup = command "cup" [] M let cap = command "cap" [] M let ast = command "ast" [] M let sqcup = command "sqcup" [] M let sqcap = command "sqcap" [] M let circ = command "circ" [] M let lor_ = command "lor" [] M let land_ = command "land" [] M let bullet = command "bullet" [] M let oplus = command "oplus" [] M let ominus = command "ominus" [] M let diamond = command "diamond" [] M let odot = command "odot" [] M let oslash = command "oslash" [] M let uplus = command "uplus" [] M let otimes = command "otimes" [] M let bigcirc = command "bigcirc" [] M let amalg = command "amalg" [] M let bigtriangleup = command "bigtriangleup" [] M let bigtriangledown = command "bigtriangledown" [] M let dagger = command "dagger" [] M let lhd = command ~packages: ["latexsym", ""] "lhd" [] M let rhd = command ~packages: ["latexsym", ""] "rhd" [] M let ddagger = command "ddagger" [] M let unlhd = command "unlhd" [] M let unrhd = command "unrhd" [] M let wr = command "wr" [] M (*******************************************************************************) let sum = command "sum" [] M let prod = command "prod" [] M let coprod = command "coprod" [] M let bigcup = command "bigcup" [] M let bigcap = command "bigcap" [] M let bigvee = command "bigvee" [] M let bigwedge = command "bigwedge" [] M let bigsqcup = command "bigsqcup" [] M let biguplus = command "biguplus" [] M let int = command "int" [] M let oint = command "oint" [] M let bigodot = command "bigodot" [] M let bigoplus = command "bigoplus" [] M let bigotimes = command "bigotimes" [] M (*******************************************************************************) let leftarrow = command "leftarrow" [] M let rightarrow = command "rightarrow" [] M let leftrightarrow = command "leftrightarrow" [] M let leftarrow_ = command "Leftarrow" [] M let rightarrow_ = command "Rightarrow" [] M let leftrightarrow_ = command "Leftrightarrow" [] M let longleftarrow = command "longleftarrow" [] M let longrightarrow = command "longrightarrow" [] M let longleftrightarrow = command "longleftrightarrow" [] M let longleftarrow_ = command "Longleftarrow" [] M let longrightarrow_ = command "Longrightarrow" [] M let longleftrightarrow_ = command "Longleftrightarrow" [] M let iff = command "iff" [] M let mapsto = command "mapsto" [] M let longmapsto = command "longmapsto" [] M let hookleftarrow = command "hookleftarrow" [] M let hookrightarrow = command "hookrightarrow" [] M let leftharpoonup = command "leftharpoonup" [] M let rightharpoonup = command "rightharpoonup" [] M let leftharpoondown = command "leftharpoondown" [] M let rightharpoondown = command "rightharpoondown" [] M let rightleftharpoons = command "rightleftharpoons" [] M let uparrow = command "uparrow" [] M let downarrow = command "downarrow" [] M let updownarrow = command "updownarrow" [] M let uparrow_ = command "Uparrow" [] M let downarrow_ = command "Downarrow" [] M let updownarrow_ = command "Updownarrow" [] M let nearrow = command "nearrow" [] M let searrow = command "searrow" [] M let swarrow = command "swarrow" [] M let nwarrow = command "nwarrow" [] M let leadsto = command ~packages: ["latexsym", ""] "leadsto" [] M (*******************************************************************************) let mathbb x = command "mathbb" ~packages:["amssymb",""] [M, x] M let align x = environment "align" (M, x) T let align_ x = environment "align*" (M, x) T let gather x = environment "gather" (M, x) T let gather_ x = environment "gather*" (M, x) T let split x = environment "split" (M,x) M let proof ?opt t = let opt = Opt.map (fun x -> T, x) opt in environment "proof" ?opt (T, t) T let twoheadrightarrow = command "twoheadrightarrow" [] M let square = command ~packages:["amssymb",""] "square" [] M (*******************************************************************************) let mathpar l = let content = M, concat (list_insert (command ~packages: ["mathpartir", ""] "and" [] M) l) in environment ~packages: ["mathpartir", ""] "mathpar" content T let inferrule ?lab ?left ?right ?vdots ?width ?leftskip ?rightskip lx ly = let lx, ly = match lx, ly with | [], [] -> [text "~"], [] | _, _ -> lx, ly in let cx = concat (list_insert newline lx) in let cy = concat (list_insert newline ly) in let left = Opt.map (fun x -> text "left=" ^^ x) left in let right = Opt.map (fun x -> text "right=" ^^ x) right in let lab = Opt.map (fun x -> text "lab=" ^^ x) lab in let vdots = Opt.map (fun x -> text "vdots=" ^^ latex_of_size x) vdots in let width = Opt.map (fun x -> text "width=" ^^ latex_of_size x) width in let leftskip = Opt.map (fun x -> text "leftskip=" ^^ latex_of_size x) leftskip in let rightskip = Opt.map (fun x -> text "rightskip=" ^^ latex_of_size x) rightskip in let option_list = [ left; right; lab; vdots; width; leftskip; rightskip ] in let opt = concat (list_insert (text ",") (list_filter_options option_list)) in command ~packages: ["mathpartir", ""] ~opt: (A, opt) "inferrule*" [M, cx; M, cy] M (*******************************************************************************) let cmd_stmaryrd = command ~packages: ["stmaryrd", ""] let llbracket = cmd_stmaryrd "llbracket" [] M let rrbracket = cmd_stmaryrd "rrbracket" [] M let llparenthesis = cmd_stmaryrd "llparenthesis" [] M let rrparenthesis = cmd_stmaryrd "rrparenthesis" [] M (*******************************************************************************) let slide x = environment "slide" (T, x) T (*******************************************************************************) (* Some contributions from Vincent Aravantinos *) let cmd_no_arg ?(packages=[]) cmd = command ~packages cmd [] T let cmd_one_arg ?(packages=[]) cmd arg = command ~packages cmd [T,arg] T let cmd_two_args ?(packages=[]) cmd arg1 arg2 = command ~packages cmd [T,arg1;T,arg2] T let math_cmd_no_arg ?(packages=[]) cmd = command ~packages cmd [] M let math_cmd_one_arg ?(packages=[]) cmd arg = command ~packages cmd [M,arg] M let math_cmd_two_args ?(packages=[]) cmd arg1 arg2 = command ~packages cmd [M,arg1;M,arg2] M (* Misc *) let par_ = cmd_no_arg "S" let hyphen = cmd_no_arg "-" let quote txt = environment "quote" (T,txt) T let quotation txt = environment "quotation" (T,txt) T let appendix = cmd_no_arg "appendix" let neg = math_cmd_no_arg "neg" let mathrm = math_cmd_one_arg "mathrm" let mathfrak = math_cmd_one_arg "mathfrak" let frontmatter = cmd_no_arg "frontmatter" let backmatter = cmd_no_arg "backmatter" let mainmatter = cmd_no_arg "mainmatter" let geq = math_cmd_no_arg "geq" let leq = math_cmd_no_arg "leq" let dots = cmd_no_arg "dots" let ldots = cmd_no_arg "ldots" let underbrace x y = (math_cmd_no_arg "underbrace")^^(index x y) let overbrace x y = (math_cmd_no_arg "overbrace")^^(exponent x y) let not_ = (^^) (math_cmd_no_arg "not") let neq = ne let to_ = rightarrow (* Low-Level *) let atbegindocument = cmd_one_arg "AtBeginDocument" let addcontentsline toc section name = command "addcontentsline" [T,toc; T,section; T,name] T let vfill = text "\\vfill " let vfil = text "\\vfil " let pagestyle = cmd_one_arg "pagestyle" let thispagestyle = cmd_one_arg "thispagestyle" (* AMS *) let black_triangle_left = math_cmd_no_arg ~packages:["amsmath",""] "blacktriangleleft" let black_triangle_right = math_cmd_no_arg ~packages:["amsmath",""] "blacktriangleright" (*******************************************************************************) module type BEAMER = sig type beamertemplate = [ `NavigationSymbols | `Footline ] type tocoptions = [ `CurrentSection | `CurrentSubsection | `HideAllSubsections | `HideOtherSubsections | `PauseSections | `PauseSubsections ] val frame: ?title: t -> ?subtitle: t -> t -> t val setbeamertemplate: beamertemplate -> t -> t val insertpagenumber: t val insertdocumentendpage: t val inserttitle: t val insertsection: t val insertsubsection: t val insertshorttitle: t val insertshortsection: t val insertshortsubsection: t val tableofcontents: tocoptions list -> t val at_begin_section: t -> t val at_begin_subsection: t -> t val at_begin_subsubsection: t -> t val block: t -> t -> t (** [block title body] *) type color = [ | `Gray | `Red | `Green | `Blue | `Yellow | `RGB of float * float * float ] val color: color -> t -> t type overlays_spec = [`I of int] (*val command: ?packages: (string * string) list -> string -> ?only: overlays_spec list -> ?opt: (mode * t) -> (mode * t) list -> mode -> t*) val only: overlays_spec list -> t -> t val includegraphics: ?only: overlays_spec list -> t -> t type column_alignment = [ `T | `C | `B ] val columns: ?align: column_alignment -> t -> t val column: ?align: column_alignment -> size -> t -> t val equi_columns: ?align: column_alignment -> t list -> t end module Beamer = struct let frame ?title ?subtitle body = let x = concat [ optcmd "frametitle" title; optcmd "framesubtitle" subtitle; body; ] in environment "frame" (T, x) T type beamertemplate = [ `NavigationSymbols | `Footline ] let setbeamertemplate template body = let template = match template with | `NavigationSymbols -> "navigation symbols" | `Footline -> "footline" in let template = text template in command "setbeamertemplate" [T, template; T, body] T let insertpagenumber = command "insertpagenumber" [] T let insertdocumentendpage = command "insertdocumentendpage" [] T let inserttitle = command "inserttitle" [] T let insertsection = command "insertsection" [] T let insertsubsection = command "insertsubsection" [] T let insertshorttitle = command "insertshorttitle" [] T let insertshortsection = command "insertshortsection" [] T let insertshortsubsection = command "insertshortsubsection" [] T type tocoptions = [ `CurrentSection | `CurrentSubsection | `HideAllSubsections | `HideOtherSubsections | `PauseSections | `PauseSubsections ] let tableofcontents options = let options = make_option T begin function | `CurrentSection -> "currentsection" | `CurrentSubsection -> "currentsubsection" | `HideAllSubsections -> "hideallsubsections" | `HideOtherSubsections -> "hideothersubsections" | `PauseSections -> "pausesections" | `PauseSubsections -> "pausesubsections" end options in command "tableofcontents" ?opt: options [] T let at_begin_section x = command "AtBeginSection" [T, x] T let at_begin_subsection x = command "AtBeginSubsection" [T, x] T let at_begin_subsubsection x = command "AtBeginSubsubsection" [T, x] T let block title body = environment "block" ~args: [T, title] (T, body) T type color = [ | `Gray | `Red | `Green | `Blue | `Yellow | `RGB of float * float * float ] let color c x = match c with | `RGB (r, g, b) -> let rgb = string_of_float r^","^string_of_float g^","^string_of_float b in within_braces begin concat [ command "color" ~opt: (A, text "rgb") [A, text rgb] A; x ] end | _ -> within_braces begin concat [ command "color" [A, match c with | `Gray -> text "gray" | `Red -> text "red" | `Green -> text "green" | `Blue -> text "blue" | `Yellow -> text "yellow" | `RGB (r, g, b) -> assert false ] A; x ] end type overlays_spec = [`I of int] let string_of_overlays_spec name = function | [] -> name | l -> let l = List.map (function `I i -> string_of_int i) l in let s = String.concat "," l in sprintf "%s<%s>" name s let unusual_command ?packages name ?(only=[]) args mode = unusual_command ?packages (string_of_overlays_spec name only) args mode let command ?packages name ?(only=[]) ?opt args mode = command ?packages (string_of_overlays_spec name only) args mode (*TODO A posibility for a command to have a result mode which depend of the mode of its argument*) let only only arg = command "only" ~only [A,arg] A let includegraphics ?only filename = command ?only "includegraphics" [ T, filename ] T type column_alignment = [ `T | `C | `B ] let letter_of_column_alignment = function | `T -> A, text "t" | `C -> A, text "c" | `B -> A, text "b" let columns ?align x = environment "columns" ?opt: (Opt.map letter_of_column_alignment align) (T, x) T let column ?align size x = environment "column" ?opt: (Opt.map letter_of_column_alignment align) ~args: [A, latex_of_size size] (T, x) T let equi_columns ?align cols = let count = List.length cols in if count <= 0 then error "equi_columns requires at least 1 column"; let size = `Textwidth (1. /. float_of_int count) in let cols = List.map (column size) cols in columns ?align (concat cols) end module Verbatim = struct open Str let alphanumplus = regexp "[a-zA-Z0-9]+" let ident = regexp "_?[a-zA-Z][a-zA-Z0-9]*\\(_[a-zA-Z0-9]+\\)*" let underscore = regexp "_" let verbatim s = concat begin List.flatten begin List.map begin function | Delim s -> [ text s ] | Text s -> let l = ref [] in for i = String.length s - 1 downto 0 do l := s.[i] :: !l done; List.map (function | ' ' -> (*text "~"(*command " " [] T*)*) command "hphantom" [T, text " "] T | '\n' -> newline | '\r' -> empty | c -> symbolc c) !l end (full_split alphanumplus s) end end let rec regexps regapps remapp s = match regapps with | [] -> remapp s | (r, a)::rem -> concat begin List.map begin function | Delim s -> a s | Text s -> regexps rem remapp s end (full_split r s) end let trim_begin chars s = let len = String.length s in let b = ref 0 in while !b < len && List.mem s.[!b] chars do incr b done; if !b < len then String.sub s !b (len - !b) else "" let trim_end chars s = let len = String.length s in let e = ref (len-1) in while !e >= 0 && List.mem s.[!e] chars do decr e done; if 0 <= !e then String.sub s 0 (!e + 1) else "" let trim chars s = let len = String.length s in let b = ref 0 in while !b < len && List.mem s.[!b] chars do incr b done; let e = ref (len-1) in while !e >= 0 && List.mem s.[!e] chars do decr e done; if !b <= !e then String.sub s !b (!e - !b + 1) else "" let split_lines s = Str.split (Str.regexp_string "\n") s let pseudocode ?(trim = trim ['\n']) ?(id_regexp = ident) ?(kw_apply = textbf) ?(id_apply = mathit) ?(rem_apply = verbatim) ?(keywords = []) ?(symbols = []) ?(keyword_symbols = []) ?(underscore = underscore) s = let identifier_nosplit kw = try List.assoc kw keyword_symbols with Not_found -> if List.mem kw keywords then kw_apply (text kw) else id_apply (text kw) in let indexify_identifier id = function | [] -> id | indexes -> let indexes = List.map identifier_nosplit indexes in index id (scriptsize (concat (list_insert (text ",") indexes))) in let s = trim s in let ident_regexp = (ident, fun s -> let us_split = split_delim underscore s in match us_split with | [] -> empty | kw::rem -> indexify_identifier (identifier_nosplit kw) rem) in let symbol_regexps = List.map (fun (s, l) -> regexp_string s, fun _ -> l) symbols in regexps (ident_regexp :: symbol_regexps) rem_apply s let keywords ?(apply = textbf) k s = regexps [regexp (String.concat "\\|" k), fun x -> apply (verbatim x)] verbatim s end melt-1.4.0/latex/latex.odocl0000644000175000017500000000000511661167412015265 0ustar romainromainLatexmelt-1.4.0/HOWTO-dist.txt0000644000175000017500000000213611661167412014422 0ustar romainromainThis file is only intended for developpers as a reminder of how to make a release. * Check that all text files are LICENSEd. grep -L Copyright `darcs query manifest` | grep -v .png | grep -v .xcf Don't bother adding the LICENSE to very small files or files for which licensing does not really make sense. * Check the README. * Check that there is no new, unrecorded file. darcs whatsnew -ls * Open melt_version.ml and update the version number if needed. * Make the .tgz. make dist * Check that it compiles and executes. tar tf (file).tgz cd (dir) make bench (the slides need two passes, this is normal) * Check noob.makefile. In particular, check that it does not contain any absolute path, and check that it compiles and execute. * Check the list of changes and prepare a summary. darcs changes --from-tag x.y The CHANGES file should be up-to-date already, but this allows to make sure. * TAG the version. darcs tag x.y * Create a new version on the forge with the summary of changes, and upload the .tar.gz to the OCaml Forge. * Anounce the new version with the summary of changes. melt-1.4.0/prelude/0000755000175000017500000000000011661167412013456 5ustar romainromainmelt-1.4.0/prelude/pqueue.ml0000644000175000017500000001073111661167412015316 0ustar romainromain(**************************************************************************) (* Copyright (c) 2010, Arnaud Spiwack *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (*** Persistent, constant time queues ***) (* spiwack: a short comment on the choice of this particular implementation (physicist's queue from Okasaki's Purely Functional Datastructure). Melt is batch-compiled, hence we do not need the hassle of having a good worst-time analysis, amortised performances are quite sufficient. Physicist's queues are arguably the most simple kind of amortised queues, it requires less suspension than the banker's queues (which incidentally should hopefully mean that it has a lower overhead). I chose this implementation rather than a simpler and more efficient one in a (mostly) single threaded setting to cope with copying of pieces of [Latex.t].*) (* For a detailed description of the implementation and its time analysis see Pysicist's queues from Okasaki's Purely Functional Datastructures. *) type 'a t = { (* An already forced prefix of [front] from which values are peeked. *) working: 'a list ; (* Length of [front]. *) lenf: int ; (* Front of the queue. *) front: 'a list Lazy.t ; (* Length of [rear]. *) lenr: int ; (* Rear of the queue, in reversed order. *) rear: 'a list } exception Empty let empty = { working = [] ; lenf = 0 ; front = Lazy.lazy_from_val [] ; lenr = 0 ; rear = [] } (* An invariant is that [lenr] <= [lenf], hence if [lenf=0] then [lenr=0]. *) let is_empty q = q.lenf = 0 (* After [ensure_working], [working] is empty if and only if [lenf=0]. *) let ensure_working = function | { working=[] } as q -> { q with working = Lazy.force q.front } | q -> q (* After [ensure_invariant], [working is empty if and only if [lenf=0] and [lenr]<=[lenf] *) let ensure_invariant q = if q.lenr <= q.lenf then ensure_working q else let f = Lazy.force q.front in ensure_working { working = f ; lenf = q.lenf+q.lenr ; front = lazy (f@(List.rev q.rear)) ; lenr = 0 ; rear = [] } let push x q = ensure_invariant { q with lenr = q.lenr+1 ; rear = x::q.rear } let peek = function | { working = [] } -> raise Empty | { working = x::_ } -> x let pop = function | { working = [] } -> raise Empty | { working = _::w } as q -> ensure_invariant { q with working = w ; lenf = q.lenf-1 ; front = lazy (List.tl (Lazy.force q.front)) } melt-1.4.0/prelude/pqueue.mli0000644000175000017500000000542611661167412015474 0ustar romainromain(**************************************************************************) (* Copyright (c) 2010, Arnaud Spiwack *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (*** Persistent, constant time queues ***) type +'a t (** Raised by operations which do not support empty queues as argument. *) exception Empty (** [empty] is the empty queue. *) val empty : 'a t (** [is_empty q] returns [true] if and only if [q] is the empty queue. *) val is_empty : 'a t -> bool (** [push x q] adds [x] at the back of [q] *) val push : 'a -> 'a t -> 'a t (** [peek q] returns the value at the front of [q]. If [q] is empty, raises {!Empty}. *) val peek : 'a t -> 'a (** [pop q] removes the value at the front of [q]. If [q] is empty, raises {!Empty}. *) val pop : 'a t -> 'a t melt-1.4.0/prelude/clist.ml0000644000175000017500000000752411661167412015136 0ustar romainromain(**************************************************************************) (* Copyright (c) 2010, Arnaud Spiwack *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (*** Lists with constant time concatenation ***) (* The datastructure is taken from Okasaki's Purely Functional Datastructures. It is dubbed "Catenable Lists" and "Lists with efficient catenation". *) exception Empty type 'a t = E | Cons of 'a*('a t Lazy.t Pqueue.t) let empty = E let is_empty = function E -> true | _ -> false let link x q s = Cons (x,Pqueue.push s q) (* [force_link] is a variant of link called on deep lists: the only possible E is the outermost constructor *) let force_link q s = match q with | E -> assert false | Cons (x,q) -> link x q s let linkall q = let rec linkall q = let t = Lazy.force (Pqueue.peek q) in let q = Pqueue.pop q in if Pqueue.is_empty q then t else force_link t (lazy (linkall q)) in if Pqueue.is_empty q then E else linkall q let app l1 l2 = match l1,l2 with | _,E -> l1 | E,_ -> l2 | Cons (x,l1),_ -> link x l1 (Lazy.lazy_from_val l2) let singleton x = Cons (x,Pqueue.empty) let cons x l = app (singleton x) l let head = function | E -> raise Empty | Cons (a,_) -> a let tail = function | E -> raise Empty | Cons (_,q) -> linkall q let rec fold_left f a l = if is_empty l then a else fold_left f (f a (head l)) (tail l) let list_cons l t = List.fold_right cons l t let of_list l = list_cons l empty let list_concat ls = List.fold_left app empty ls let concat ls = fold_left app empty ls let rec iter f l = if is_empty l then () else (f (head l); iter f (tail l)) let rec map f l = if is_empty l then empty else cons (f (head l)) (map f (tail l)) let rec forall p l = if is_empty l then true else p (head l) && forall p (tail l) melt-1.4.0/prelude/clist.mli0000644000175000017500000000735111661167412015305 0ustar romainromain(**************************************************************************) (* Copyright (c) 2010, Arnaud Spiwack *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (*** Lists with constant time concatenation ***) type +'a t (** [Empty] is raised by [head] and [tail] if the list is empty. *) exception Empty (** [empty] is the empty list. *) val empty : 'a t (** [is_empty l] returns [true] if and only if [l] is the empty list. *) val is_empty : 'a t -> bool (** [cons x l] adds [x] in front of [l]. *) val cons : 'a -> 'a t -> 'a t (** [singleton x] is the list comprised only of [x]. *) val singleton : 'a -> 'a t (** [app l r] appends [r] at the end of [l]. *) val app : 'a t -> 'a t -> 'a t (** [of_list l] returns the Clist.t equivalent to [l]. *) val of_list : 'a list -> 'a t (** [list_cons [x1;...;xn] l] returns [(cons x1 ... (cons xn l) ...)]. *) val list_cons : 'a list -> 'a t -> 'a t (** first element of the list. *) val head : 'a t -> 'a (** the list without its first element. *) val tail : 'a t -> 'a t (** [fold_left f a [b1; ...; bn]] is [f (... (f (f a b1) b2) ...) bn]. *) val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a (** [list_concat [l1;l2;...;ln] returns the list app l1 (app l2 (app ... ln)). *) val list_concat : 'a t list -> 'a t (** [concat [l1;l2;...;ln] returns the list app l1 (app l2 (app ... ln)). *) val concat : 'a t t -> 'a t (** [iter f [x1;x2;...;xn]] is equivalent to [f x1; f x2; ...; f xn]. *) val iter : ('a -> unit) -> 'a t -> unit (** [map f [x1;x2;...;xn]] is equivalent to [[f x1; f x2; ...; f xn]]. *) val map : ('a -> 'b) -> 'a t -> 'b t (** [forall p l] is true if [p] holds on every element of l. *) val forall : ('a -> bool) -> 'a t -> bool melt-1.4.0/.authorspellings0000644000175000017500000000027711661167412015250 0ustar romainromainRomain Bardou Arnaud Spiwack François Bobot Pierre Chambart Vincent Aravantinos melt-1.4.0/melt_version.ml0000644000175000017500000000026311661167412015057 0ustar romainromainlet major = 1 let minor = 4 let release = 0 let full = string_of_int major ^ "." ^ string_of_int minor ^ "." ^ string_of_int release let print () = Printf.printf "%s\n%!" full melt-1.4.0/totoconf.mli0000644000175000017500000001514511661167412014362 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (** Tools to write configuration files. *) val force: ?option: string -> string -> string -> Arg.key * Arg.spec * Arg.doc (** [force var doc] return a command line argument specification usable in the [~spec] argument of [init]. Default value for [~option] is ["-"^var]. The user can use the [option] command line argument to force the value of variable [var]. The value will be checked, and if the check fails, the configuration script will exit. Else the value will be used for [var]. If variable [var] is not used by the configuration script, forcing its value has no effect. *) val init: ?file: string -> ?spec: (Arg.key * Arg.spec * Arg.doc) list -> unit -> unit (** Initialize the module. Should be called before anything else. - [~file]: configuration file name. Default is ["Config"]. Can be overwritten using the [-c] option. - [~spec]: additional options. *) val finish: unit -> unit (** Print warnings and write new configuration. *) (** {2 Errors and Warnings} *) val echo: ('a, unit, string, unit) format4 -> 'a val debug: ('a, unit, string, unit) format4 -> 'a val error: ('a, unit, string, unit) format4 -> 'a val warning: ('a, unit, string, unit) format4 -> 'a (** {2 Shell} *) (** {3 Low-Level} *) exception Exec_error of int val exec_line: string -> string list -> string (** Execute a command with parameters. Return the first line of its standard output. *) val which: string -> string (** Find a file in [PATH]. Raise [Not_found] if the file cannot be found. *) (** {3 High-Level} *) val guess_bins: string list -> unit -> string list (** Apply [which] to each file in the list. Only keep existing files. Used as a [~guess] argument of [VAR.make]. *) (** {2 Version Parsing} *) module Version: sig val compare: string -> string -> int val eq: string -> string -> bool val ne: string -> string -> bool val le: string -> string -> bool val lt: string -> string -> bool val ge: string -> string -> bool val gt: string -> string -> bool end (** {2 Options} *) val interactive: bool ref (** Command line option [-i]: interactive mode. *) val config_file: string ref (** Configuration file name. *) (** {2 Variables} *) type 'a var val (!!): 'a var -> 'a module type STRINGABLE = sig type t val to_string: t -> string val of_string: string -> t option (** This function shall return [None] if its parameter is not a valid string representation of a [t]. *) end module type VAR = sig type data val make: ?query: string -> ?check: (data -> bool) -> ?guess: (unit -> data list) -> ?fail: (unit -> data) -> string -> data var (** Build a configuration variable. The old value (if any) is tried first. Then guessed values are tried. The user may then be invited to confirm or enter a new value. The variable will be printed when [finish] is executed. - [~query]: description of the variable. It is used when asking the user to confirm the variable if interactive mode is set. The user can change the value, which is then checked. With no description, there is no confirmation. The description is also used to print the final value to the user. - [~check]: function used to check if a given value is correct for the variable. Default always return [true]. - [~guess]: function used to guess default values. The result is a list of guesses which are tried in order until one of them passes [~check]. Default returns an empty list. - [~fail]: function used to return a default value. This default value is not checked. This function may typically raise an exception, call [error] or [warning]. Default value calls [error]. *) val umake: ?query: string -> ?check: (data -> bool) -> ?guess: (unit -> data list) -> ?fail: (unit -> data) -> string -> unit (** Same as [make] but does not return the variable. *) val simple: string -> data -> data var (** Build a simple variable with a name and a value. *) val usimple: string -> data -> unit (** Same as [simple] but does not return the variable. *) val get: data var -> data val print: Format.formatter -> data var -> unit end module Var: functor(T: STRINGABLE) -> VAR with type data = T.t module SVar: VAR with type data = string module BVar: VAR with type data = bool module IVar: VAR with type data = int module FVar: VAR with type data = float (** {2 String Utils} *) module Str: sig val last_word: string -> string val replace_char: string -> char -> char -> string end melt-1.4.0/meltpp/0000755000175000017500000000000011661167412013317 5ustar romainromainmelt-1.4.0/meltpp/parser.mly0000644000175000017500000000770711661167412015351 0ustar romainromain/**************************************************************************/ /* Copyright (c) 2009, Romain BARDOU */ /* All rights reserved. */ /* */ /* Redistribution and use in source and binary forms, with or without */ /* modification, are permitted provided that the following conditions are */ /* met: */ /* */ /* * Redistributions of source code must retain the above copyright */ /* notice, this list of conditions and the following disclaimer. */ /* * Redistributions in binary form must reproduce the above copyright */ /* notice, this list of conditions and the following disclaimer in the */ /* documentation and/or other materials provided with the distribution. */ /* * Neither the name of Melt nor the names of its contributors may be */ /* used to endorse or promote products derived from this software */ /* without specific prior written permission. */ /* */ /* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */ /* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */ /* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR */ /* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */ /* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */ /* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT */ /* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, */ /* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY */ /* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT */ /* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE */ /* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /**************************************************************************/ %{ open Ast let verb name items = let name = match name with | Some name -> VNUser name | None -> match items with | `Item(delim, _) :: _ -> VNDelim delim | _ -> VNDefault in let items = List.map begin function | `Item(_, s) -> VString s | `Code x -> VCode x | `Math x -> VMath x | `Text x -> VText x end items in Verb(name, items) %} %token STRING %token COMMENT %token EOF %token TEXT_BEGIN TEXT_END %token MATH_BEGIN MATH_END %token CODE_BEGIN CODE_END %token VERB_BEGIN %token VERB_END %token VERB_ITEM %token PAR %type file %start file %% file: | code_star EOF { Code $1 } ; code_star: | code code_star { $1::$2 } | { [] } ; text_star: | text text_star { $1::$2 } | { [] } ; math_star: | math math_star { $1::$2 } | { [] } ; verb_star: | verb verb_star { $1::$2 } | { [] } ; code: | TEXT_BEGIN text_star TEXT_END { Text $2 } | MATH_BEGIN math_star MATH_END { Math $2 } | CODE_BEGIN code_star CODE_END { Code [String "{"; Code $2; String "}"] } | STRING { String $1 } | COMMENT { Comment $1 } ; text: | MATH_BEGIN math_star MATH_END { Math $2 } | CODE_BEGIN code_star CODE_END { Code $2 } | VERB_BEGIN verb_star VERB_END { verb $1 $2 } | STRING { String $1 } | PAR { Par $1 } | COMMENT { Comment $1 } ; math: | TEXT_BEGIN text_star TEXT_END { Text $2 } | CODE_BEGIN code_star CODE_END { Code $2 } | STRING { String $1 } | COMMENT { Comment $1 } ; verb: | TEXT_BEGIN text_star TEXT_END { `Text $2 } | MATH_BEGIN math_star MATH_END { `Math $2 } | CODE_BEGIN code_star CODE_END { `Code $2 } | VERB_ITEM { `Item $1 } ; melt-1.4.0/meltpp/meltpp_plugin.mli0000644000175000017500000001242411661167412016704 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (** Meltpp plugin API. *) (** {2 Verbatim functions} *) (** About the expressive power of verbatim functions: there are three kinds of verbatim functions. - The meta verbatim functions are called by meltpp when printing the pre-processed file. They have the greatest expressive power: they can parse the quotation, and include the anti-quotations anywhere. This means that the anti-quotations can be of any type (at the non-meta level). - The complex verbatim functions are called by the program printed by meltpp. Their expressive power differs for the anti-quotations, which must all be of the same type. - The simple verbatim functions just take strings. They don't care about anti-quotations. A simple verbatim function is an instance of a complex verbatim function which applies the simple function to all items and concatenates the results, anti-quotation being inserted as-it. *) type verbatim_item = [ | `V of string | `C of Format.formatter -> unit -> unit | `M of Format.formatter -> unit -> unit | `T of Format.formatter -> unit -> unit ] (** A verbatim item is either a verbatim string or an anti-quotation. Anti-quotations can be code anti-quotations ([`C]), math anti-quotations ([`M]) or text anti-quotations ([`T]). Applying the anti-quotation will print its piece of code, with no extra parenthesis. It can be used with the ["%a"] formatter. *) type verbatim_function = Format.formatter -> verbatim_item list -> unit (** A verbatim function takes an output channel and a list of verbatim items. It should print some piece of code on the output channel, corresponding to the translation of the verbatim items. *) val declare_verbatim_function: string -> verbatim_function -> unit (** [f "x" x] declare the verbatim_function [x] of name ["x"]. The function can then be used as a verbatim mode. *) val verbatim_complex: string -> verbatim_function (** [verbatim_complex "f"] is a verbatim function which prints a piece of code which will apply [f] to the [verbatim_item list], which is printed as an expression of type [[ `V of string | `C of 'a | `M of Latex.t | `T of Latex.t ] list]. *) val verbatim_simple: string -> verbatim_function (** [verbatim_simple "f"] is a verbatim function which prints a piece of code which will apply [f] to all quotations parts, keeping the anti-quotations as it. The default verbatim function is actually [verbatim_simple "Latex.Verbatim.verbatim"]. *) (** {2 Miscellaneous} *) val list_insert: 'a -> 'a list -> 'a list (** Insert a value between each element of a list: [list_insert x [e1; ...; en]] returns [[e1; x; e2; x; ...; x; en]]. In particular, if [n <= 1] the list is left unchanged. *) val list_iter_concat: Format.formatter -> (Format.formatter -> 'a -> unit) -> 'a list -> unit (** [list_iter_concat fmt f l]: [f] is supposed to print each item of [l] as a piece of code of type [Latex.t]. Concatenations are inserted between each item to produce a piece of code of type [Latex.t]. *) val escape_except_newline: string -> string (** Escape special Ocaml characters, except "\n". This allows a string to be printed in the source code without changing the line numbers. *) melt-1.4.0/meltpp/meltpp_plugin.ml0000644000175000017500000000721711661167412016537 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Format type verbatim_item = Plugin_private.verbatim_item type verbatim_function = Plugin_private.verbatim_function let declare_verbatim_function = Hashtbl.add Plugin_private.verbatim_functions let rec list_insert acc x = function | a::r -> list_insert (a::x::acc) x r | [] -> match List.rev acc with | [] -> [] | _::r -> r let list_insert x = list_insert [] x let list_iter_concat fmt f = function | [] -> fprintf fmt "(text \"\")" | l -> let l = List.map (fun x -> `I x) l in let l = list_insert `C l in fprintf fmt "("; List.iter begin function | `I x -> fprintf fmt "(%a)" f x | `C -> fprintf fmt "^^" end l; fprintf fmt ")" let escape_except_newline s = let l = Str.split_delim (Str.regexp "\n") s in let l = List.map String.escaped l in String.concat "\n" l let verbatim_complex name: verbatim_function = fun f l -> let l = list_insert `I (l :> [ verbatim_item | `I ] list) in fprintf f "(%s [" name; List.iter begin function | `V s -> fprintf f "`V \"%s\"" (escape_except_newline s) | `C a -> fprintf f "`C(%a)" a () | `M a -> fprintf f "`M(%a)" a () | `T a -> fprintf f "`T(%a)" a () | `I -> fprintf f "; " end l; fprintf f "])" let verbatim_simple name: verbatim_function = fun f l -> list_iter_concat f begin fun f -> function | `V s -> fprintf f "(%s \"%s\")" name (escape_except_newline s) | `C a | `M a | `T a -> fprintf f "(%a)" a () end l melt-1.4.0/meltpp/lexer.mll0000644000175000017500000002304111661167412015144 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) { open Parser open Lexing type mode = | C | M | T | V of string option exception Lexical_error of (Lexing.position * Lexing.position) (* offending position *) * (mode * (Lexing.position * Lexing.position)) list (* stack of open modes *) * string (* further explanation *) let loc lexbuf = (lexeme_start_p lexbuf, lexeme_end_p lexbuf) let lex_error lexbuf stack s = Printf.ksprintf (fun s -> raise (Lexical_error(loc lexbuf, stack, s))) s let newline lexbuf = let pos = lexbuf.lex_curr_p in lexbuf.lex_curr_p <- { pos with pos_lnum = pos.pos_lnum + 1; pos_bol = pos.pos_cnum } let get_stack,get_mode, begin_mode, end_mode, reset_mode, top_level = let mode = ref [] in (* get stack is for use in [lex_error] *) begin fun () -> !mode end, begin fun () -> match !mode with | (m,_)::_ -> m | [] -> C end, begin fun m lexbuf -> mode := (m , loc lexbuf) :: !mode; match m with | C -> CODE_BEGIN | M -> MATH_BEGIN | T -> TEXT_BEGIN | V apply -> VERB_BEGIN apply end, begin fun lexbuf -> match !mode with | (m,_)::rem -> mode := rem; begin match m with | C -> CODE_END | M -> MATH_END | T -> TEXT_END | V _ -> VERB_END end | [] -> lex_error lexbuf !mode "mismatched mode delimiter" end, begin fun () -> mode := [] end, begin fun () -> !mode = [] end (* should be defined inside the tuple, but we're facing the value restriction here, and it so happens that [lex_error] must have arbitrary return type, thus the convoluted workaround. *) let lex_error lexbuf s = lex_error lexbuf (get_stack ()) s let verb_buf = Buffer.create 16 let comment_buf = Buffer.create 42 let comment_nests = ref 0 let start_comment () = incr comment_nests; Buffer.add_string comment_buf "(*" (* Close the current comment. If we are still in a comment, raise Exit. Else, return a COMMENT token containing the whole comment. *) let end_comment () = decr comment_nests; Buffer.add_string comment_buf "*)"; if !comment_nests >= 1 then raise Exit; let s = Buffer.contents comment_buf in Buffer.reset comment_buf; COMMENT s let pragma_return lexbuf = newline lexbuf; STRING "\n" (* to keep the line count correct *) let verbatim_delims = Hashtbl.create 7 let add_verb_delim lexbuf delim ident = match delim with | '$' | '"' | '{' -> lex_error lexbuf "Character '%c' is not allowed as a verbatim delimiter." delim | _ -> Hashtbl.add verbatim_delims delim ident } let space = [' ' '\t'] let lalpha = ['a'-'z'] let ualpha = ['A'-'Z'] let alpha = (lalpha | ualpha) let num = ['0'-'9'] let alpha_num = (alpha | num) let ident = alpha (alpha_num | '_')* rule code = parse | "##" { pragma lexbuf } | '"' { begin_mode T lexbuf } | '$' { begin_mode M lexbuf } | '{' { begin_mode C lexbuf } | '}' { end_mode lexbuf } | '\n' { newline lexbuf; STRING "\n" } | "\\\"" { STRING "\"" } | "\\\\" { STRING "\\" } | "\\r" { STRING "\\r" } | "\\n" { STRING "\\n" } | "\\t" { STRING "\\t" } | '\\' num num num as x { STRING x } | '\\' [^ '"' '\\' 'r' 'n' 't' '0'-'9'] | '\\' num [^'0'-'9'] { lex_error lexbuf "invalid escaping in code mode" } | "(*" { start_comment (); comment lexbuf } | '(' { STRING "(" } | '#' { STRING "#" } | [^ '"' '$' '}' '{' '\n' '\\' '(' '#']+ { STRING(lexeme lexbuf) } | eof { if top_level () then EOF else lex_error lexbuf "unexpected end of file in code mode" } and pragma = parse | "plugin" { pragma_plugin lexbuf; pragma_return lexbuf } | "verbatim" { pragma_verbatim lexbuf; pragma_return lexbuf } | _ { lex_error lexbuf "syntax error in pragma" } and pragma_plugin = parse | space+ (ident as name) space* '\n' { Plugin_private.load_plugin name } | _ { lex_error lexbuf "syntax error in pragma plugin" } and pragma_verbatim = parse | space* '\'' (_ as delim) '\'' space* '=' space* ((ident ('.' ident)*) as ident) space* '\n' { add_verb_delim lexbuf delim ident } | _ { lex_error lexbuf "syntax error in pragma verbatim" } and comment = parse | "*)" { try end_comment () with Exit -> comment lexbuf } | "(*" { start_comment (); comment lexbuf } | '\n' { newline lexbuf; Buffer.add_char comment_buf '\n'; comment lexbuf } | "\\\"" { Buffer.add_char comment_buf '"'; comment lexbuf } | (_ as c) { Buffer.add_char comment_buf c; comment lexbuf } | eof { lex_error lexbuf "unexpected end of file in comment" } and math = parse | '"' { begin_mode T lexbuf } | '{' { begin_mode C lexbuf } | '}' { lex_error lexbuf "end of Code mode while in Math mode"} | '$' { end_mode lexbuf } | '\n' { newline lexbuf; STRING "\n" } | '%' { STRING "\\%" } | "\\\\" { STRING "\\\\" } | "\\{" { STRING "\\{" } | "\\}" { STRING "\\}" } | "\\$" { STRING "\\$" } | "\\\"" { STRING "\"" } | "\\&" { STRING "\\&" } | "\\ " { STRING "\\ " } | "\\_" { STRING "\\_" } | '\\' [^ '\\' '{' '}' '$' '"' '&' ' ' '_'] { lex_error lexbuf "invalid escaping in math mode" } | "(*" { start_comment (); comment lexbuf } | '(' { STRING "(" } | [^ '"' '$' '{' '\n' '\\' '}' '%' '(']+ { STRING(lexeme lexbuf) } | eof { lex_error lexbuf "unexpected end of file in math mode" } and text = parse | '$' { begin_mode M lexbuf } | '{' { begin_mode C lexbuf } | '}' { lex_error lexbuf "end of Code mode while in Text mode"} | '"' { end_mode lexbuf } | "<:" (['a'-'z' 'A'-'Z' '0'-'9' '.' ' ' '_']+ as apply) ':' { begin_mode (V(Some apply)) lexbuf } | '<' { begin_mode (V None) lexbuf } | ('\n' (' ' | '\t' )* )+ '\n' { let s = lexeme lexbuf in let l = ref 0 in String.iter (fun c -> if c='\n' then (newline lexbuf ; incr l)) s; PAR !l } | '\n' { newline lexbuf; STRING "\n" } | '#' { STRING "\\#" } | '_' { STRING "\\_" } | '%' { STRING "\\%" } | "\\\\" { STRING "\\\\" } | "\\{" { STRING "\\{" } | "\\}" { STRING "\\}" } | "\\$" { STRING "\\$" } | "\\\"" { STRING "\"" } | "\\&" { STRING "\\&" } | "\\ " { STRING "\\ " } | "\\'" { STRING "\\'" } | "\\`" { STRING "\\`" } | '\\' [^ '\\' '{' '}' '$' '"' '&' ' '] { lex_error lexbuf "invalid escaping in text mode" } | "(*" { start_comment (); comment lexbuf } | '(' { STRING "(" } | [^ '"' '$' '{' '<' '\n' '\\' '#' '_' '^' '}' '%' '(']+ { STRING(lexeme lexbuf) } | eof { lex_error lexbuf "unexpected end of file in text mode" } and verb = parse | '>' { end_mode lexbuf } | '"' { begin_mode T lexbuf } | '$' { begin_mode M lexbuf } | '{' { begin_mode C lexbuf } | '<' { verb_item '>' lexbuf } | (_ as c) { verb_item c lexbuf } | eof { lex_error lexbuf "unexpected end of file in verbatim mode" } and verb_item delim = parse | (_ as c) { if c = delim then begin let s = Buffer.contents verb_buf in Buffer.reset verb_buf; VERB_ITEM(delim, s) end else begin Buffer.add_char verb_buf c; verb_item delim lexbuf end } | eof { lex_error lexbuf "unexpected end of file in verbatim mode" } { let token lexbuf = match get_mode () with | C -> code lexbuf | M -> math lexbuf | T -> text lexbuf | V _ -> verb lexbuf } melt-1.4.0/meltpp/main.ml0000644000175000017500000002166211661167412014604 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Ast open Lexing open Lexer open Parser open Format open Meltpp_plugin let dir = ref "" let meltpp_verbatim_default_name = "meltpp_verbatim_default" let error = (* Let's call "commands" expressions of type [Format.formatter -> (Format.formatter -> 'k) ->'k], with the intention that a command prints something into the formatter and then gives it to its continuation. Commands can be given a monoid structure which we write [(<:>)] , [unit] (the definitions are much in the spirit of the continuation monad in Haskell). With [a<:>b] executing [a] first, then [b], then its continuation and [unit] doing nothing and executes its continuation. *) let (<:>) a b k fmt = a (fun fmt' -> b k fmt') fmt in let unit k fmt = k fmt in (* [flush fmt] executes [cmd] on the formatter [fmt] then flushes [fmt]. *) let flush fmt cmd = cmd (fun fmt' -> fprintf fmt' "@.") fmt in (* We use continuation passing style to change the order in which arguments are needed by fprintf. The cost is that we have to indirect through a string which means we lose some of the abilities of format strings. *) let print_gen k m = let buf = Buffer.create 42 in kfprintf (fun buffmt -> fprintf buffmt "@?"; k (Buffer.contents buf)) (formatter_of_buffer buf) m in let print m = print_gen (fun s k fmt -> kfprintf k fmt "%s" s) m in let print_loc (b,e) = print "File \"%s%s\", line %d, characters %d-%d:" !dir b.pos_fname b.pos_lnum (b.pos_cnum - b.pos_bol) (e.pos_cnum - b.pos_bol) in let print_msg loc m = print_loc loc <:> print "@\n" <:> print "%s" m <:> print "@\n" in let string_mode = function | C -> "Code mode" | M -> "Math mode" | T -> "Text mode" | V None -> "Verbatim mode" | V (Some name) -> sprintf "Verbatim mode (%s)" name in let print_mode_line (m,lc) = print_loc lc <:> print "@,"<:>print "%s opened and pending@," (string_mode m) in let print_mode_stack ms = List.fold_left (<:>) unit (List.map print_mode_line ms) in let print_err_msg_and_exit lc stk x = flush std_formatter (print_msg lc x <:> print "@[" <:> print_mode_stack stk <:> print "@]"); exit 1 in fun lc stk m -> print_gen (print_err_msg_and_exit lc stk) m let parse_file f = let ic = open_in f in let l = from_channel ic in l.lex_curr_p <- { l.lex_curr_p with pos_fname = f }; try file token l with Lexer.Lexical_error(loc, stk, s) -> error loc stk "Melt parse error: %s" s let rec interp code = function | String s -> if code then ICode s else IString s | Comment s -> if code then ICode s else IComment s | Code l -> interp_list true l | Math l -> IApply("mode M", interp_list false l) | Text l -> IApply("mode T", interp_list false l) | Verb(f, l) -> let f = match f with | VNDefault -> meltpp_verbatim_default_name | VNUser s -> s | VNDelim c -> try Hashtbl.find Lexer.verbatim_delims c with Not_found -> meltpp_verbatim_default_name in let l = List.map begin function | VString s -> VIString s | VCode l -> VICode(interp_list true l) | VMath l -> VIMath(interp_list false l) | VText l -> VIText(interp_list false l) end l in IVerb(f, l) | Par n -> ICode ("(par)" ^ String.make n '\n') and interp_list code l = let l = List.map (interp code) l in if code then IConcatCode l else IConcat l let rec print f = function | ICode s -> fprintf f "%s" s | IString "\n" -> fprintf f "(text \"\\n\")\n" | IComment s -> fprintf f "(text \"\"%s)" s | IString s -> fprintf f "(text \"%s\")" (String.escaped s) | IConcat l -> begin match l with | [] -> fprintf f "(text \"\")" | [x] -> print f x | x::rem -> fprintf f "(("; print f x; fprintf f ")"; List.iter (fun y -> fprintf f " ^^ (%a)" print y) rem; fprintf f ")" end | IConcatCode l -> List.iter (print f) l | IApply(n, i) -> fprintf f "(%s (%a))" n print i | IVerb(vf, l) -> let vf = try Hashtbl.find Plugin_private.verbatim_functions vf with Not_found -> verbatim_complex vf in let l = List.map begin function | VIString s -> `V s | VICode i -> `C (fun f () -> print f i) | VIMath i -> `M (fun f () -> print f i) | VIText i -> `T (fun f () -> print f i) end l in vf f l let output = ref "" let files = Queue.create () let plugins = Queue.create () let opens = Queue.create () let add_open x = Queue.add x opens let includes = ref [] let add_include x = includes := x :: !includes let spec = Arg.align [ "-P", Arg.String add_include, " Look for plugins in "; "-o", Arg.Set_string output, " Output file name (cannot be used when \ compiling multiple files at the same time)"; "-open", Arg.String add_open, " Add \"open Module;;\" at \ the beginning of the file"; "-dir", Arg.Set_string dir, " Add to the file location (for \ error message locations only)"; "-version", Arg.Unit Melt_version.print, " Print version"; ] let usage = "Usage: " ^ Filename.basename Sys.argv.(0) ^ " [options] [plugins] files Plugins should be OCaml compiled modules or archives." let file_ext s = try let i = String.rindex s '.' in String.sub s i (String.length s - i) with Not_found -> "" let anon s = match file_ext s with | ".cma" | ".cmo" | ".cmxs" -> Queue.add s plugins | _ -> Queue.add s files let print_opens oc = Queue.iter begin fun m -> fprintf oc "open %s;;\n\n" m end opens (* default environment *) let () = declare_verbatim_function meltpp_verbatim_default_name (verbatim_simple "Latex.Verbatim.verbatim") (* parse arguments *) let () = Arg.parse spec anon usage; Plugin_private.includes := List.rev !includes; if !output <> "" && Queue.length files > 1 then begin eprintf "Cannot use the -o option when compiling multiple files \ at the same time.\n%!"; exit 1 end (* command line plugins *) let () = Queue.iter Plugin_private.load_plugin plugins (* main *) let () = Queue.iter begin fun filename -> let ast = parse_file filename in let outputname = if !output <> "" then !output else Filename.chop_extension filename in let ast' = interp true ast in let oc = open_out outputname in let fmt = formatter_of_out_channel oc in print_opens fmt; fprintf fmt "# 1 \"%s%s\"\n" !dir (String.escaped filename); print fmt ast'; close_out oc end files (* Artificial dependencies, for plugin to be able to use melt libraries *) open Latex open Melt melt-1.4.0/meltpp/ast.mli0000644000175000017500000000567011661167412014621 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) type verb_name = | VNUser of string | VNDelim of char | VNDefault type verb_item = | VString of string | VCode of item list | VMath of item list | VText of item list and item = | String of string | Comment of string (* kept for better error locations *) | Code of item list | Math of item list | Text of item list | Verb of verb_name * verb_item list | Par of int (* the int is the number of new lines in the source code *) type verb_interp = | VIString of string | VICode of interp | VIMath of interp | VIText of interp and interp = | IString of string | IComment of string | ICode of string | IConcat of interp list | IConcatCode of interp list | IApply of string * interp | IVerb of string * verb_interp list melt-1.4.0/meltpp/plugin_private.ml0000644000175000017500000000653211661167412016707 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Printf let includes = ref [] type verbatim_item = [ | `V of string | `C of Format.formatter -> unit -> unit | `M of Format.formatter -> unit -> unit | `T of Format.formatter -> unit -> unit ] type verbatim_function = Format.formatter -> verbatim_item list -> unit let verbatim_functions: (string, verbatim_function) Hashtbl.t = Hashtbl.create 7 let find name = let rec f = function | [] -> eprintf "Error: Cannot find plugin %s.\n" name; exit 2 | i::r -> let name = Filename.concat i name in if Sys.file_exists (name^".cmxs") then name^".cmxs" else if Sys.file_exists (name^".cmo") then name^".cmo" else if Sys.file_exists (name^".cma") then name^".cma" else f r in f !includes let load_plugin = let init = ref false in fun name -> if not !init then begin Dynlink.init (); Dynlink.prohibit ["Ast"; "Lexer"; "Parser"; "Plugin_private"]; init := true; end; try Dynlink.loadfile (find name) with Sys_error s -> eprintf "%s\nError: Cannot load plugin %s.\n" s name; exit 2 | Dynlink.Error m -> eprintf "%s" (Dynlink.error_message m); exit 2 melt-1.4.0/install.ml0000644000175000017500000001761411661167412014027 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Printf #use "melt_version.ml" let bin = ref "" let lib = ref "" let man = ref "" let build = ref "" let uninstall = ref false let fake = ref false let mlpost = ref true let config_bool v s = let value = match String.uppercase s with | "YES" | "ON" | "TRUE" | "1" -> true | _ -> false in v := value let speclist = Arg.align [ "-mlpost", Arg.String (config_bool mlpost), " Value of MLPOST value in Config file"; "-bin", Arg.Set_string bin, " Install directory (program binaries)"; "-lib", Arg.Set_string lib, " Install directory (OCaml libraries)"; "-man", Arg.Set_string man, " Install directory (man pages)"; "-build", Arg.Set_string build, " Base build directory"; "-uninstall", Arg.Set uninstall, " Uninstall instead of install"; "-fake", Arg.Set fake, " Do not execute commands, only print them"; ] let anon_fun x = raise (Arg.Bad ("Unknown parameter: "^x)) let usage_msg = "ocaml install.ml -bin -lib " let check sr = if !sr = "" then begin Arg.usage speclist usage_msg; exit 1 end let () = Arg.parse speclist anon_fun usage_msg; check bin; check lib let script = Queue.create () let rec first name = function | [] -> eprintf "Warning: file %s has not been compiled.\n" name; raise Not_found | x::r -> let x = if !build = "" then x else !build ^ "/" ^ x in if Sys.file_exists x then x else first name r let add_com com = Queue.add (`Com com) script let add_fun s f = Queue.add (`Fun (s,f)) script let mkdir dir = add_com (sprintf "mkdir -p %s" dir) let install_file name = add_com (sprintf "install -D -m 644 %s %s/%s" name !lib name) let install_lib l = let base = Filename.basename l in try let l = first base [l] in add_com (sprintf "install -D -m 644 %s %s/%s" l !lib base) with Not_found -> () let install_bin b final = try let b = first final b in add_com (sprintf "install -D %s %s/%s" b !bin final) with Not_found -> () let install_man m final = try add_com (sprintf "install -D %s %s/%s" m !man final) with Not_found -> () let rm f = if Sys.file_exists f then add_com (sprintf "rm %s" f) else eprintf "Warning: file %s does not exist.\n" f let rm_dir f = if Sys.file_exists f then add_com (sprintf "rmdir %s" f) else eprintf "Warning: dir %s does not exist or is not empty.\n" f let uninstall_file file = rm (Filename.concat !lib file) let uninstall_lib l = uninstall_file (Filename.basename l) let uninstall_bin _ final = rm (Filename.concat !bin final) let uninstall_man _ final = rm (Filename.concat !man final) let do_file = if !uninstall then uninstall_file else install_file let do_lib = if !uninstall then uninstall_lib else install_lib let do_bin = if !uninstall then uninstall_bin else install_bin let do_man = if !uninstall then uninstall_man else install_man let check_code = function | 0 -> () | n -> exit n let execute = function | `Com cmd -> printf "%s\n%!" cmd; if not !fake then check_code (Sys.command cmd) | `Fun (s,f) -> printf "%s\n%!" s; if not !fake then f () let finish () = Queue.iter execute script (**************************************************************************) (* Ocamlfind META file *) (**************************************************************************) type meta = { description : string; version : string; requires : string list; archive : ([`Byte |`Native] list * string list) list; subpackage : (string * meta) list } let create_meta ?(filename="META") meta = (* CREATE META FILE *) let rec print_meta o meta = fprintf o "description = \"%s\"\n" meta.description; fprintf o "version = \"%s\"\n" meta.version; (match meta.requires with | [] -> () | _ -> fprintf o "requires = \"%s\"\n" (String.concat " " meta.requires); ); List.iter (fun (preds,l) -> fprintf o "archive(%s) = \"%s\"\n" (String.concat "," (List.map (function | `Byte -> "byte" | `Native -> "native") preds)) (String.concat " " l)) meta.archive; List.iter (fun (s,m) -> fprintf o "package \"%s\" (\n%a)\n" s print_meta m) meta.subpackage in add_fun (sprintf "META file created in %s" filename) (fun () -> let o = open_out filename in print_meta o meta; close_out o) let do_meta () = if !uninstall then uninstall_file "META" else let meta_latex = { version = full; description = "Latex library for OCaml."; archive = [ [`Byte], ["latex.cma"]; [`Native], ["latex.cmxa"] ]; requires = ["str"]; subpackage = [] } in let meta_melt = { version = full; description = "Melt allows you to write Latex documents using OCaml."; requires = ["melt.latex"] @ (if !mlpost then ["mlpost"] else []); archive = [ [`Byte], ["melt.cma"]; [`Native], ["melt.cmxa"] ]; subpackage= ["latex", meta_latex] } in create_meta ~filename:(Filename.concat !lib "META") meta_melt let () = do_bin ["meltpp/main.native"; "meltpp/main.byte"] "meltpp"; do_bin ["melt/tool.native"; "melt/tool.byte"] "meltbuild"; do_bin ["latop/latop.native"; "latop/latop.byte"] "latop"; List.iter do_lib [ "latex/latex.a"; "latex/latex.cmi"; "latex/latex.cma"; "latex/latex.cmxa"; "melt/melt.a"; "melt/melt.cmi"; "melt/melt.cma"; "melt/melt.cmxa"; "meltpp/meltpp_plugin.cmi" ]; do_meta (); do_man "man/meltbuild.1" "meltbuild.1"; do_man "man/meltpp.1" "meltpp.1"; do_man "man/latop.1" "latop.1"; if !uninstall then rm_dir !lib; finish () melt-1.4.0/noob.makefile0000644000175000017500000002326511661167412014462 0ustar romainromain########################################################################## # Copyright (c) 2009, Romain BARDOU # # All rights reserved. # # # # Redistribution and use in source and binary forms, with or without # # modification, are permitted provided that the following conditions are # # met: # # # # * Redistributions of source code must retain the above copyright # # notice, this list of conditions and the following disclaimer. # # * Redistributions in binary form must reproduce the above copyright # # notice, this list of conditions and the following disclaimer in the # # documentation and/or other materials provided with the distribution. # # * Neither the name of Melt nor the names of its contributors may be # # used to endorse or promote products derived from this software # # without specific prior written permission. # # # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS # # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR # # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT # # OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, # # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, # # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY # # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE # # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # ########################################################################## include Config default: all Config: configure.ml ocaml configure.ml install: $(OCAML) install.ml -bin $(INSTALLBIN) -lib $(INSTALLLIB) uninstall: $(OCAML) install.ml -bin $(INSTALLBIN) -lib $(INSTALLLIB) -uninstall all: $(OCAMLC) $(OCAMLINCLUDES) -c -I prelude -I melt -I meltpp -I latex -o prelude/pqueue.cmi prelude/pqueue.mli $(OCAMLC) $(OCAMLINCLUDES) -c -I prelude -I melt -I meltpp -I latex -o prelude/clist.cmi prelude/clist.mli $(OCAMLC) $(OCAMLINCLUDES) -c -I latex -I melt -I meltpp -I prelude -o latex/variable.cmi latex/variable.mli $(OCAMLC) $(OCAMLINCLUDES) -c -I latex -I melt -I meltpp -I prelude -o latex/latex.cmi latex/latex.mli $(OCAMLC) $(OCAMLINCLUDES) -c -I prelude -I melt -I meltpp -I latex -o prelude/pqueue.cmo prelude/pqueue.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I prelude -I melt -I meltpp -I latex -o prelude/clist.cmo prelude/clist.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I latex -I melt -I meltpp -I prelude -o latex/variable.cmo latex/variable.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I latex -I melt -I meltpp -I prelude -o latex/latex.cmo latex/latex.ml $(OCAMLC) $(OCAMLINCLUDES) -a prelude/pqueue.cmo prelude/clist.cmo latex/variable.cmo latex/latex.cmo -o latex/latex.cma cp $(MLPOSTSPECIFIC) melt/mlpost_specific.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt/melt_common.cmo melt/melt_common.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt/mlpost_specific.cmo melt/mlpost_specific.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt/melt.cmi melt/melt.mli $(OCAMLC) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/meltpp_plugin.cmi meltpp/meltpp_plugin.mli $(OCAMLC) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/plugin_private.cmo meltpp/plugin_private.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt/melt.cmo melt/melt.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/meltpp_plugin.cmo meltpp/meltpp_plugin.ml $(OCAMLC) $(OCAMLINCLUDES) -a prelude/pqueue.cmo prelude/clist.cmo latex/variable.cmo latex/latex.cmo melt/melt_common.cmo melt/mlpost_specific.cmo melt/melt.cmo meltpp/plugin_private.cmo meltpp/meltpp_plugin.cmo -o melt/melt.cma $(OCAMLC) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt_version.cmo melt_version.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o totoconf.cmi totoconf.mli $(OCAMLC) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt/tool.cmo melt/tool.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o totoconf.cmo totoconf.ml $(OCAMLC) $(OCAMLINCLUDES) unix.cma str.cma bigarray.cma cairo.cma bitstring.cma mlpost.cma latex/variable.cmo prelude/pqueue.cmo prelude/clist.cmo latex/latex.cmo melt/melt_common.cmo melt/mlpost_specific.cmo melt/melt.cmo melt_version.cmo totoconf.cmo melt/tool.cmo -o melt/tool.byte $(OCAMLC) $(OCAMLINCLUDES) -c -I latop -I melt -I meltpp -I prelude -I latex -o latop/latop.cmo latop/latop.ml $(OCAMLC) $(OCAMLINCLUDES) unix.cma str.cma latop/latop.cmo -o latop/latop.byte $(OCAMLLEX) -q meltpp/lexer.mll $(OCAMLYACC) meltpp/parser.mly $(OCAMLC) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/ast.cmi meltpp/ast.mli $(OCAMLC) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/parser.cmi meltpp/parser.mli $(OCAMLC) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/lexer.cmo meltpp/lexer.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/main.cmo meltpp/main.ml $(OCAMLC) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/parser.cmo meltpp/parser.ml $(OCAMLC) $(OCAMLINCLUDES) dynlink.cma unix.cma str.cma bigarray.cma cairo.cma bitstring.cma mlpost.cma latex/variable.cmo prelude/pqueue.cmo prelude/clist.cmo latex/latex.cmo melt/melt_common.cmo melt/mlpost_specific.cmo melt/melt.cmo melt_version.cmo meltpp/parser.cmo meltpp/plugin_private.cmo meltpp/lexer.cmo meltpp/meltpp_plugin.cmo meltpp/main.cmo -o meltpp/main.byte $(OCAMLOPT) $(OCAMLINCLUDES) -c -I prelude -I melt -I meltpp -I latex -o prelude/pqueue.cmx prelude/pqueue.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I prelude -I melt -I meltpp -I latex -o prelude/clist.cmx prelude/clist.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I latex -I melt -I meltpp -I prelude -o latex/variable.cmx latex/variable.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I latex -I melt -I meltpp -I prelude -o latex/latex.cmx latex/latex.ml $(OCAMLOPT) $(OCAMLINCLUDES) -a prelude/pqueue.cmx prelude/clist.cmx latex/variable.cmx latex/latex.cmx -o latex/latex.cmxa $(OCAMLOPT) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt/melt_common.cmx melt/melt_common.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt/mlpost_specific.cmx melt/mlpost_specific.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/plugin_private.cmx meltpp/plugin_private.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt/melt.cmx melt/melt.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/meltpp_plugin.cmx meltpp/meltpp_plugin.ml $(OCAMLOPT) $(OCAMLINCLUDES) -a prelude/pqueue.cmx prelude/clist.cmx latex/variable.cmx latex/latex.cmx melt/melt_common.cmx melt/mlpost_specific.cmx melt/melt.cmx meltpp/plugin_private.cmx meltpp/meltpp_plugin.cmx -o melt/melt.cmxa $(OCAMLOPT) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt_version.cmx melt_version.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o totoconf.cmx totoconf.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I melt -I meltpp -I prelude -I latex -o melt/tool.cmx melt/tool.ml $(OCAMLOPT) $(OCAMLINCLUDES) unix.cmxa str.cmxa bigarray.cmxa cairo.cmxa bitstring.cmxa mlpost.cmxa latex/variable.cmx prelude/pqueue.cmx prelude/clist.cmx latex/latex.cmx melt/melt_common.cmx melt/mlpost_specific.cmx melt/melt.cmx melt_version.cmx totoconf.cmx melt/tool.cmx -o melt/tool.native $(OCAMLOPT) $(OCAMLINCLUDES) -c -I latop -I melt -I meltpp -I prelude -I latex -o latop/latop.cmx latop/latop.ml $(OCAMLOPT) $(OCAMLINCLUDES) unix.cmxa str.cmxa latop/latop.cmx -o latop/latop.native $(OCAMLOPT) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/parser.cmx meltpp/parser.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/lexer.cmx meltpp/lexer.ml $(OCAMLOPT) $(OCAMLINCLUDES) -c -I meltpp -I melt -I prelude -I latex -o meltpp/main.cmx meltpp/main.ml $(OCAMLOPT) $(OCAMLINCLUDES) dynlink.cmxa unix.cmxa str.cmxa bigarray.cmxa cairo.cmxa bitstring.cmxa mlpost.cmxa latex/variable.cmx prelude/pqueue.cmx prelude/clist.cmx latex/latex.cmx melt/melt_common.cmx melt/mlpost_specific.cmx melt/melt.cmx melt_version.cmx meltpp/parser.cmx meltpp/plugin_private.cmx meltpp/lexer.cmx meltpp/meltpp_plugin.cmx meltpp/main.cmx -o meltpp/main.native $(OCAMLDOC) $(OCAMLINCLUDES) -dump latex/latex.odoc -hide-warnings -I latex -I melt -I meltpp -I prelude latex/latex.mli rm -rf latex/latex.docdir mkdir -p latex/latex.docdir $(OCAMLDOC) $(OCAMLINCLUDES) -load latex/latex.odoc -html -hide-warnings -d latex/latex.docdir $(OCAMLDOC) $(OCAMLINCLUDES) -dump melt/mlpost_specific.odoc -hide-warnings -I melt -I meltpp -I prelude -I latex melt/mlpost_specific.ml $(OCAMLDOC) $(OCAMLINCLUDES) -dump melt/melt.odoc -hide-warnings -I melt -I meltpp -I prelude -I latex melt/melt.mli rm -rf melt/melt.docdir mkdir -p melt/melt.docdir $(OCAMLDOC) $(OCAMLINCLUDES) -load melt/mlpost_specific.odoc -load melt/melt.odoc -html -hide-warnings -d melt/melt.docdir melt-1.4.0/latop/0000755000175000017500000000000011661167412013135 5ustar romainromainmelt-1.4.0/latop/latop.ml0000644000175000017500000001007611661167412014612 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Format open Str let fle = regexp "\\([^:]*\\):\\([0-9]+\\): *\\(.*\\)" let warning = regexp "LaTeX Warning: *\\(.*\\)" let fatal = regexp " *==> Fatal error" let ucs = regexp " *Undefined control sequence" let ucs_cmd = regexp ".*\\\\\\([^\\]+\\)" let badness = regexp ".*badness" type error = | Fatal | Undefined_control_sequence of string | Unknown of string type line = | Normal of string | Error of string * int * error (** file, line, error *) | Warning of string let parse_error err = if string_match fatal err 0 then Fatal else if string_match ucs err 0 then let line = read_line () in ignore (read_line ()); if string_match ucs_cmd line 0 then Undefined_control_sequence (matched_group 1 line) else Undefined_control_sequence "???" else Unknown err let parse_line line = if string_match fle line 0 then let file = matched_group 1 line in let line_nb = int_of_string (matched_group 2 line) in let err = parse_error (matched_group 3 line) in Error (file, line_nb, err) else if string_match warning line 0 then Warning (matched_group 1 line) else if string_match badness line 0 then Warning line else Normal line let reprint_line = function | Normal line -> eprintf "%s\n" line | Error (file, line, error) -> if error <> Fatal then eprintf "File \"%s\", line %d:\n" file line; begin match error with | Fatal -> printf "%!"; eprintf "%!"; exit 1 | Undefined_control_sequence cmd -> eprintf "Undefined control sequence: %s\n" cmd | Unknown msg -> eprintf "%s\n" msg end | Warning msg -> eprintf "Latex Warning: %s\n" msg let () = printf "latop !\n%!"; try while true do reprint_line (parse_line (read_line ())) done with End_of_file -> printf "%!"; eprintf "%!"; melt-1.4.0/bench/0000755000175000017500000000000011661167412013075 5ustar romainromainmelt-1.4.0/bench/variables.mlt0000644000175000017500000000135711661167412015571 0ustar romainromainlet newtheorem name = let c = variable 0 in fun desc body -> "{medskip} {noindent}{textbf "{name} {incr_var c}{vari c} ({desc})"}~ {body} {medskip}" let definition = newtheorem "Definition" let theorem = newtheorem "Theorem" let () = emit (document " {definition "Safety" "The property of being safe."} {definition "Soundness" "The property of being sound."} {theorem "Safety and Soundness" "Safety and soundness are more or less the same, but not quite."} {definition "Lightness" "The property of being light."} {definition "Fireness" "The property of being fire."} {theorem "Nessnessness" "Sound, light and fire are words, soundness is also a word, lightness is probably a word, but fireness is definitely not a word in my book."} ") melt-1.4.0/bench/ref.mlt0000644000175000017500000000025211661167412014366 0ustar romainromainlet lbl_intro = label () let intro = concat [ section ~label: lbl_intro "Introduction"; "This is Sect.~{ref_ lbl_intro}."; ] let () = emit begin document intro end melt-1.4.0/bench/verb.mlt0000644000175000017500000000047011661167412014552 0ustar romainromainlet tt x = texttt (Verbatim.verbatim x) let caml x = mode M (Verbatim.keywords [\"let\"; \"in\"] x) let () = emit begin document "soit <:tt:> un bout de <:tt:+v_e_r_b+> facile {par} Un peu de Caml: {displaymath "<:caml:>"}" end melt-1.4.0/bench/comment.mlt0000644000175000017500000000105111661167412015252 0ustar romainromainlet x = "coucou" (* ceci est un commentaire (* imbrique (* de surcroit *) mais bon (* on s'en fout un peu *) *) ou pas *) let y (* un peu de melt dans un commentaire: "bla$bli$" (* imbrique "b{l}u" *) *) = "tata" (* et voici du melt non termine: $blabla a noter que ca ne marche pas avec les guillemets doubles vu que Caml va raler de toute facon *) let () = emit (document "x = {x}(* commentaire (* imbrique *) dans du texte *), y = {y}, z = $42 (* commentaire (* imbrique *) *)+12$ Parentheses and stars in math mode, with a space: $( * * )$") melt-1.4.0/bench/plugs/0000755000175000017500000000000011661167412014227 5ustar romainromainmelt-1.4.0/bench/plugs/quot.ml0000644000175000017500000000070511661167412015553 0ustar romainromainopen Meltpp_plugin open Format let test fmt l = list_iter_concat fmt begin fun fmt -> function | `V s -> fprintf fmt "text \"--Quotation V: %s--\"" s | `C a -> fprintf fmt "text \"--Anti-quotation C: \"^^%a^^text \"--\"" a () | `M a -> fprintf fmt "text \"--Anti-quotation M: \"^^%a^^text \"--\"" a () | `T a -> fprintf fmt "text \"--Anti-quotation T: \"^^%a^^text \"--\"" a () end l let () = declare_verbatim_function "test" test melt-1.4.0/bench/mlpost-figure.mlt0000644000175000017500000000065011661167412016411 0ustar romainromainopen Mlpost open Tree open Box open Picture open Num let _ = emit begin document ~title: "Test" ~author: "Romain Bardou" ~packages: ["graphicx", ""] "Small test of Mlpost inclusion: {mlpost (Tree.draw ( bin ~ls: (cm 1.5) ~cs: (cm 0.6) (pic (picture_of_latex "Cou{alpha}cou")) (leaf (pic (picture_of_latex "Arf"))) (leaf (pic (picture_of_latex "Plop"))) ))} Does it work?" end melt-1.4.0/bench/slides.mlt0000644000175000017500000004772711661167412015117 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (* Here are some slides I used to give a talk about Melt to my research team. *) open Beamer (* set_prelude is only available in versions > 0.8.1 of mlpost if you really want to compile this file with mlpost <= 0.8.1, delete the following three lines; then, compile twice to obtain a fixpoint *) let () = let prelude = documentclass "beamer" in Mlpost.Defaults.set_prelude (Latex.to_string prelude) let slides ?title ?author ?date list = (* Disable Beamer navigation symbols. *) let prelude = setbeamertemplate `NavigationSymbols "" in (* Compute the slides. *) let contents = List.map (fun (title, body) -> frame ~title body) list in let contents = concat contents in (* Print the slides. *) emit (document ~documentclass: `Beamer ?title ?author ?date ~prelude contents) let rec list_mapi ?(acc = []) ?(n = 0) f = function | [] -> List.rev acc | x :: r -> list_mapi ~acc: (f n x :: acc) ~n: (n + 1) f r let list_insert sep = function | [] | [_] as x -> x | x::rem -> List.flatten ([x]::(List.map (fun x -> [sep; x]) rem)) let toc, section = let sections = variable [] in (* accumulate the list of section titles *) (* produce a table of contents page, highlighting section number [index] (starting from 1) if specified *) let toc ?index all_sections = (* Colorize titles. *) let blue = `RGB (0., 0., 0.7) in let colors = match index with | None -> List.map (fun _ -> blue) all_sections | Some index -> list_mapi (fun i title -> if i+1 = index then blue else `Gray) all_sections in let all_sections = List.map2 color colors all_sections in (* Make them bigger. *) let all_sections = List.map large2 all_sections in (* Insert some space. *) let all_sections = list_insert "{par}{bigskip}" all_sections in concat all_sections in (* toc_slide *) (fun () -> "", final sections toc), (* section *) (fun title -> setf sections (fun sections -> sections @ [ title ]), get sections (fun now -> final sections (toc ~index: (List.length now)))) (* Macros *) let ocaml = "OCaml" let emph = color `Red let display = parbox (`Textwidth 1.) let display_box x = framebox (`Textwidth 1.) (parbox (`Textwidth 0.98) x) let one_item x = itemize [x] let my_enumerate items = let items = list_mapi (fun i item -> "{textbf "{latex_of_int i})"} {item}\\") items in concat items let verbatim_keywords = Latex.Verbatim.keywords ~apply: (fun _ -> texttt (symbolc '_')) [\"_\"] let ocaml_code_base x = Latex.Verbatim.pseudocode ~trim: (fun s -> s) ~id_apply: (fun i -> textsf (verbatim_keywords (to_string i))) ~kw_apply: (fun x -> textbf (textsf x)) ~rem_apply: (fun s -> texttt (Latex.Verbatim.verbatim s)) ~keywords: [\"let\"; \"in\"; \"val\"; \"fun\"; \"type\"; \"open\"] ~symbols: [\"->\", rightarrow] ~underscore: (Str.regexp \"__\") x let string_color = `RGB (0., 0., 0.75) let comment_color = `RGB (0.75, 0., 0.) let ocaml_code ?(trim = true) x = Verbatim.regexps [ Str.regexp \"\034\\\\([\\\\]\034\\\\|[^\034]\\\\)*\034\", (fun s -> color string_color (texttt (Latex.Verbatim.verbatim s))); Str.regexp \"\\\\\036\\\\([\\\\]\\\\\036\\\\|[^\\\\\036]\\\\)*\\\\\036\", (fun s -> color string_color (texttt (Latex.Verbatim.verbatim s))); Str.regexp \"(\\\\*\\\\([^*]\\\\|\\\\*[^)]\\\\)*\\\\*)\", (fun s -> color comment_color (textit (text s))); Str.regexp \"'a\", (fun _ -> alpha); ] ocaml_code_base (if trim then Verbatim.trim ['\n'] x else x) let split_modes_str x = let stack = ref [] in let current = ref `C in let begin_pos = ref 0 in let queue = ref [] in let atom mode end_pos = let sub = String.sub x !begin_pos (end_pos - !begin_pos + 1) in begin_pos := end_pos + 1; queue := (mode, sub) :: !queue in let begin_mode mode pos = atom !current (pos - 1); stack := !current :: !stack; current := mode in let end_mode pos = atom !current pos; current := List.hd !stack; stack := List.tl !stack in let len = String.length x in for i = 0 to len - 1 do match !current, x.[i] with | `C, '\125' -> end_mode i | `C, '\036' -> begin_mode `M i | `C, '\034' -> begin_mode `T i | `M, '\123' -> begin_mode `C i | `M, '\036' -> end_mode i | `M, '\034' -> begin_mode `T i | `T, '\123' -> begin_mode `C i | `T, '\036' -> begin_mode `M i | `T, '\034' -> end_mode i | _ -> () done; atom !current (len - 1); List.rev !queue let math_color = `RGB (0., 0.6, 0.) let text_color = string_color let melt_code x = let x = List.map (function | `C, x -> ocaml_code ~trim: false [`V x] | `M, x -> color math_color (texttt (Latex.Verbatim.verbatim x)) | `T, x -> color text_color (texttt (Latex.Verbatim.verbatim x))) (split_modes_str x) in concat x let bool = Verbatim.pseudocode ~symbols: [ \"/\\\\\", land_; \"\\\\/\", lor_; \"<=>\", iff; \"==>\", rightarrow_; \"<==\", leftarrow_; ] ~keyword_symbols: [\"xor\", oplus; \"xand\", otimes] (* Figures *) open Mlpost open Num let texpic = picture_of_latex let texbox ?dx ?dy ?name ?brush ?stroke ?pen ?dash ?fill ?style x = Box.pic ?dx ?dy ?name ?brush ?stroke ?pen ?dash ?fill ?style (texpic x) let melt_box x = Box.round_rect ~stroke: (Some Color.black) ~fill: (Color.rgb 0.75 1. 0.75) (texbox x) let file_box x = texbox (texttt x) let fig_meltpp = (* make boxes *) let meltpp_box = melt_box "MeltPP" in let mlt_box = file_box "toto.mlt" in let ml_box = file_box "toto.ml" in (* place boxes *) let mlt_box = Box.place ~padding: (cm 1.) `West meltpp_box mlt_box in let ml_box = Box.place ~padding: (cm 1.) `East meltpp_box ml_box in (* draw *) Command.seq [ Box.draw meltpp_box; Box.draw mlt_box; Box.draw ml_box; Arrow.box_to_box mlt_box meltpp_box; Arrow.box_to_box meltpp_box ml_box; ] let fig_tool = (* make boxes *) let meltpp_box = melt_box "Melt Tool" in let mlt_box = file_box "toto.mlt" in let ml_box = file_box "toto.pdf" in (* place boxes *) let mlt_box = Box.place ~padding: (cm 1.) `West meltpp_box mlt_box in let ml_box = Box.place ~padding: (cm 1.) `East meltpp_box ml_box in (* draw *) Command.seq [ Box.draw meltpp_box; Box.draw mlt_box; Box.draw ml_box; Arrow.box_to_box mlt_box meltpp_box; Arrow.box_to_box meltpp_box ml_box; ] let fancy_text_rotation text = let angles = [ 5.; 10.; 15.; 20.; 25.; 30.; 35. ] in let angles_neg = List.map ((-.) 0.) angles in let angles = List.rev angles_neg @ [ 0. ] @ angles in let count = List.length angles in let boxes = list_mapi (fun i angle -> let n = float_of_int i /. float_of_int count in let n = 1. -. n *. n *. n in let col = `RGB (n, n, n) in let pic = texpic (Latex.Beamer.color col text) in let tr = Transform.rotate_around (Picture.ctr pic) angle in Picture.transform [ tr ] pic) angles in let draws = List.map Command.draw_pic boxes in Command.seq draws let big_melt_box x = Box.round_rect ~dx: (cm 0.2) ~dy: (cm 0.2) ~stroke: (Some Color.black) ~fill: (Color.rgb 0.9 1. 0.9) (Box.group x) let other_box x = Box.round_rect ~stroke: (Some Color.black) ~fill: (Color.rgb 1. 1. 1.) x let lines_box l = let l = List.map texbox l in Box.vbox l let fig_full_diagram = (* make boxes *) let meltpp_box = melt_box "meltpp" in let ml_box = file_box "toto.ml" in let lines = lines_box [ "ocamlbuild"; tiny "or"; "ocamlc"; tiny "or"; "mlpost"; ] in let compile_box = other_box lines in let byte_box = file_box "toto.byte" in let run_box = other_box (texbox "run") in let tex_box = file_box "toto.tex" in let pdflatex_box = other_box (texbox "pdflatex") in let latexlib_box = melt_box "Latex lib." in let meltlib_box = melt_box "Melt lib." in (* place boxes *) let ml_box = Box.place ~padding: (cm 1.5) `South meltpp_box ml_box in let compile_box = Box.place ~padding: (cm 1.) `East ml_box compile_box in let byte_box = Box.place ~padding: (cm 1.) `North compile_box byte_box in let run_box = Box.place ~padding: (cm 1.) `East byte_box run_box in let tex_box = Box.place ~padding: (cm 1.) `South run_box tex_box in let latexlib_box = Box.place ~padding: (cm 1.) `Southwest compile_box latexlib_box in let meltlib_box = Box.place ~padding: (cm 1.) `South compile_box meltlib_box in (* bug if south of tex_box *) let pdflatex_box = Box.place ~padding: (cm 2.3) `South run_box pdflatex_box in (* make more boxes *) let melt_box = big_melt_box [ meltpp_box; ml_box; compile_box; byte_box; run_box; tex_box; pdflatex_box; latexlib_box; meltlib_box; ] in let mlt_box = file_box "toto.mlt" in let pdf_box = file_box "toto.pdf" in (* place more boxes *) let mlt_box = Box.place ~padding: (cm 1.) `North meltpp_box mlt_box in (* bug if south of tex_box or run_box *) let pdf_box = Box.place ~padding: (cm 0.7) `South melt_box pdf_box in let pdf_box = Box.shift (Point.pt (cm 2.54, cm 0.)) pdf_box in (* draw *) Command.seq [ Box.draw melt_box; Box.draw mlt_box; Box.draw ml_box; Box.draw pdf_box; Arrow.box_to_box mlt_box meltpp_box; Arrow.box_to_box meltpp_box ml_box; Arrow.box_to_box ml_box compile_box; Arrow.box_to_box compile_box byte_box; Arrow.box_to_box byte_box run_box; Arrow.box_to_box run_box tex_box; Arrow.box_to_box tex_box pdflatex_box; Arrow.box_to_box pdflatex_box pdf_box; Arrow.box_to_box latexlib_box compile_box; Arrow.box_to_box meltlib_box compile_box; ] (* Verbatim Style Abbreviations *) let tt x = texttt (Verbatim.verbatim (Verbatim.trim ['\n'] x)) let caml = ocaml_code let melt x = Verbatim.convert melt_code (Verbatim.trim ['\n'] x) let tex = tt let () = slides ~title: "Melt: {latex} with {ocaml}" ~author: "Romain Bardou" ~date: "GT ProVal\\June 11, 2010" [ "{latex} versus {ocaml}", equi_columns ~align: `T [" {latex}: {itemize [ "Beautiful documents"; "Lots of macros"; "Lots of packages"; ]} "; " {ocaml}: {itemize [ "Great programming language"; ]} "]; "Motivations for Document Programming", "Macros are good practise {display_box "<:tex:< \newcommand{\ty}{\tau} \newcommand{\subst}[3]{#1[#2/#3]} >>"} {bigskip} Document-specific environments {bigskip} {latex} libraries {bigskip} Compute results in the paper itself {bigskip} Science-fiction (or is it?): {itemize [ "Type your theorems"; "Check your proofs"; ]}"; "{latex} as a Programming Language", display "<:tex:* \long\def\@makecaption#1#2{ \vskip \abovecaptionskip \setbox\@tempboxa \hbox{{\sf\footnotesize \textbf{#1.} #2}} \ifdim \wd\@tempboxa >\hsize {\sf\footnotesize \textbf{#1.} #2\par} \else \hbox to\hsize{\hfil\box\@tempboxa\hfil} \fi} *>"; "{ocaml} as a Programming Language", "Great: {itemize [ "Typed"; "Clear semantics"; "Expressive (higher-order iterators, algebraic types...)"; "Readable errors"; "Nice syntax"; "You already use it"; ]} But: {itemize [ "Does not produce documents"; ]}"; "Melt", "An attempt to combine {itemize [ "the {emph "beauty"} of {latex} type-setting"; "the {emph "expressivity"} of {ocaml}"; ]}"; section "Basic Documents"; "Hello, World!", "<:tt:>: {display_box "<:melt:< emit (document "Hello, world!") >>"} {bigskip} Compile: {display_box "<:tt:>"} {bigskip} Obtain <:tt:>: {display_box (textrm "Hello, world!")}"; "Intermediate Files", "After Melt pre-processor, <:tt:>: {display_box "<:caml:< open Latex;; open Melt;; # 1 "../vide.mlt" emit (document (mode T ((text "tata")))) >>"} {bigskip} After compiling and running, <:tt:>: {display_box "<:tex:< \documentclass{article} \begin{document} Hello, world! \end{document} >>"}"; "Text, Math and Code Modes", "Text mode: <:tt:<"...">> {display_box "<:melt:< "Hello, world!" >>"} {bigskip} Math mode: <:tt:<$...$>> {display_box "<:melt:< $3.141592$ >>"} {bigskip} Code mode (default): <:tt:<{...}>> {display_box "<:melt:< let x = "some macro" in "Some text with {x}" >>"}"; "Arbitrary Nesting", "{display_box "<:melt:< "I know that $1+2={latex_of_int (1+2)}$" >>"} {bigskip} Produces: {display_box (textrm "I know that $1+2={latex_of_int (1+2)}$")} "; "Example: Recoding Enumerate", "{display_box "<:melt:# let enumerate items = let print_item i item = "{textbf "{latex_of_int i})"} {item}\\" in concat (list_mapi print_item items) ... enumerate ["first"; "second"; "third"] #>"} {bigskip} Result: {display_box (textrm (my_enumerate ["first"; "second"; "third"]))} "; section "The Melt Distribution"; "The Melt Pre-Processor", "Provides easy concatenation of text, math and code (optional) Adds <:caml:> {bigskip} {center (mlpost fig_meltpp)}"; "The Latex Library", "Provides bindings for: {itemize [ "Many {emph "environments"} {itemize [ texttt "document, array, itemize, figure, center..."; ]}"; "Text type-setting {emph "commands"} {itemize [ texttt "section, tableofcontents, texttt, tiny, large..."; ]}"; "Mathematical {emph "symbols"}"; "{gamma_}{rho}{epsilon}{epsilon}{kappa} {emph "letters"}, hebrew {aleph}{beth}{gimel}{daleth} and {widetilde "accents"}"; emph "Beamer"; "{latex} labels and {emph "references"}"; "Low-level stuff ({texttt "hfill, vspace, ..."})"; ]} and more."; "The Melt Tool", "Calls the pre-processor {bigskip} Compiles, links and executes the {ocaml} program {bigskip} Runs <:tt:> or <:tt:> and <:tt:> {bigskip} {center (mlpost fig_tool)} {bigskip} All intermediate files in <:tt:<_melt>> directory"; "The Melt Library", "{center (mlpost (fancy_text_rotation "Easy integration of Mlpost figures"))} {bigskip} ...and some dirty stuff for the Melt tool"; "Another Mlpost Diagram", center (mlpost fig_full_diagram); section "Mlpost Integration"; "Mlpost Integration", "{display_box "<:caml:# val picture_of_latex: Latex.t -> Mlpost.Picture.t val mlpost: Mlpost.Command.t -> Latex.t #>"} {bigskip} Write your figures in your document: {display_box "<:melt:< let fancy_text_rotation text = let pic = picture_of_latex text in ... let () = emit (document " Here is a figure: {mlpost (fancy_text_rotation "Text to rotate")} ") >>"} "; section "Verbatim Modes"; "Basic Verbatim", "Allows to print any symbol. {display_box "<:melt:# "My webpage: <>" #>"} {bigskip} Generated {latex}: {display_box "<:tex:< My webpage: http\symbol{58}\symbol{47}\symbol{47} www\symbol{46}lri\symbol{46}fr\symbol{47} \symbol{126}bardou >>"} {bigskip} Produces: {display_box (textrm "My webpage: <>") } {bigskip} Much {emph "safer"} than <:tex:<\verb>> or <:tex:<\begin{verbatim}>>. "; "Pretty-Printed Verbatim", "{display_box "<:melt:# let url (x: string) = texttt (Verbatim.verbatim x) in "My webpage: <:url:>" #>"} {bigskip} Produces: {display_box (textrm "My webpage: {texttt "<>"}") } {bigskip} In these slides: {itemize [ "a {latex} pretty-printer"; "an {ocaml} pretty-printer"; "a Melt pretty-printer"; ]} "; "Using Verbatim to Ease Writing", "A pretty-printer for boolean formulas: {display_box "<:melt:% let bool = Verbatim.pseudocode ~symbols: [ \"/\\\\\", land_; \"\\\\/\", lor_; \"<=>\", iff; \"==>\", rightarrow_; \"<==\", leftarrow_; ] ~keyword_symbols: [\"xor\", oplus; \"xand\", otimes] %>"} "; "Using Verbatim to Ease Writing", "Let's use our boolean formula pretty-printer: {display_box (footnotesize "<:melt:# "<:bool:%A /\ B \/ (C_1 xor C_2) <=> (D ==> E_1 xand E_2)%>" #>")} {bigskip} Produces: {display_box (textrm "<:bool:#A /\ B \/ (C_1 xor C_2) <=> (D ==> E_1 xand E_2)#>") } "; section "Variables"; "Motivations for Variables", "Collect data following document {emph "flow"} Use {emph "final value"} before the end {bigskip} Examples: {itemize [ "theorem {emph "counters"}"; "line numbers in code listings"; "titles for a {emph "table"} of contents"; "{emph "packages"} used by commands"; ]}"; "Variables: Interface", display_box "<:caml:# type 'a variable val variable: 'a -> 'a variable val set: 'a variable -> 'a -> t val get: 'a variable -> ('a -> t) -> t val final: 'a variable -> ('a -> t) -> t #>"; "Variables: Example", display_box "<:caml:# let sections = variable [] let section title = concat [ Latex.section title; get sections (fun s -> set sections (title :: s)); ] let enumerate_sections = final sections enumerate #>"; "Variables: Implementation", "Compute a {emph "fixpoint"} on a {emph "heterogeneous"} list of variables {longrightarrow_} a bit tricky"; section "Conclusion"; "Is it usable in practice?", "Yes: {itemize [ "all of my {emph "slides"}"; "all of my {emph "research notes"}"; "{emph "this very presentation"}"; "the Melt {emph "documentation"}"; "several full {emph "papers"}"; "several {emph "PhD"} theses"; ]} are all written or being written with Melt."; "Will it suit your needs?", "You won't be stuck with Melt {itemize [ "you can {emph "mix"} {latex} and Melt parts"; "produced <:tt:<.tex>> files are {emph "readable"} unless lots of verbatim"; ]} {bigskip} Several possible programming styles {bigskip} Based on {latex} {one_item "use the styles and classes given by your publisher"} "; "Try it now!", "{bigskip} Webpage: {display_box "<:tt:>"} {bigskip} Darcs repository: {display_box "<:tt:>"} {bigskip} Mailing-list: {display_box (footnotesize "<:tt:>")} {bigskip} {center (mlpost (fancy_text_rotation (huge2 "Melt")))}"; ] (* Local Variables: compile-command: "melt slides.mlt -pdf && evince slides.pdf" End: *) melt-1.4.0/bench/pseudocode.mlt0000644000175000017500000000102611661167412015744 0ustar romainromainlet parbox = parbox (`Textwidth 1.) let pseudocode = Verbatim.pseudocode ~keywords: [ \"let\"; \"in\" ] ~symbols: [ \"->\", rightarrow; \"*\", times ] ~keyword_symbols: [ \"fun\", lambda ] let body = " Here is a pseudocode example. {parbox "<:pseudocode:# let square = fun x -> x * x let id x = x let indented_and_weird_indexes x = fun y -> x * y * x_1 * x_123 * fun_1_2_3 * let_42_69_z_plop_arf let funny = indented x y #>"} " let () = emit (document ~title: "Latex.Verbatim.pseudocode" body) melt-1.4.0/bench/pragma-verbatim.mlt0000644000175000017500000000061511661167412016673 0ustar romainromain##verbatim '#' = test let test x = let f = function | `V s -> "Quotation {Latex.Verbatim.verbatim s}{newline}" | `C i -> "Anti-quotation (int) {text (string_of_int i)}{newline}" | `M m -> "Anti-quotation (math) {m}{newline}" | `T t -> "Anti-quotation (text) {t}{newline}" in concat (List.map f x) let () = emit (document "<#coucou#{159}#plop#$x$#plop#"roulou lou !"{42}>") melt-1.4.0/bench/doc.mlt0000644000175000017500000011173011661167412014363 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) ##verbatim '#' = verbatim_code ##verbatim '%' = ocaml_code let verbatim_code x = texttt (Verbatim.verbatim (Verbatim.trim ['\n'] x)) let verbatim_keywords = Latex.Verbatim.keywords ~apply: (fun _ -> texttt (symbolc '_')) [\"_\"] let ocaml_code_base x = Latex.Verbatim.pseudocode ~trim: (fun s -> s) ~id_apply: (fun i -> textsf (verbatim_keywords (to_string i))) ~kw_apply: (fun x -> textbf (textsf x)) ~rem_apply: (fun s -> texttt (Latex.Verbatim.verbatim s)) ~keywords: [\"let\"; \"in\"; \"val\"; \"fun\"; \"type\"] ~symbols: [\"->\", rightarrow] ~underscore: (Str.regexp \"__\") x let ocaml_code x = Verbatim.regexps [ Str.regexp \"\034\\\\([\\\\]\034\\\\|[^\034]\\\\)*\034\", (fun s -> texttt (Latex.Verbatim.verbatim s)); Str.regexp \"(\\\\*\\\\([^*]\\\\|\\\\*[^)]\\\\)*\\\\*)\", (fun s -> textit (text s)); ] ocaml_code_base (Verbatim.trim ['\n'] x) let verbatim_example_nothing = Verbatim.pseudocode ~keyword_symbols: [\"nothing\", emptyset] let verbatim_example_bool = Verbatim.pseudocode ~symbols: [ \"/\\\\\", land_; \"\\\\/\", lor_; \"<=>\", iff; \"==>\", rightarrow_; \"<==\", leftarrow_; ] ~keyword_symbols: [\"xor\", oplus; \"xand\", otimes] let lbl_latex_ocamldoc = label () let lbl_melt_tool = label () let lbl_meltpp = label () let lbl_melt_distribution = label () let latex = command \"LaTeX\" [] T let latexlib = "<%Latex%>" let melt = "Melt" let meltlib = "<%Melt%>" let ocaml = "OCaml" let ocamldoc = "Ocamldoc" let camlp4 = "Camlp4" let mlpost = textsc "Mlpost" let postscript = "Postscript" let pdf = "PDF" let ie = emph "i.e." let display x = environment \"center\" (T, command \"fbox\" [T, environment \"minipage\" ~args: [T, text \"0.9\\\\textwidth\"] (T, x) T] T) T let listing = display let todo x = "{par}{huge "{textbf "TODO:"} {x}"}{par}" let doc = (" {tableofcontents} {newpage} {section "Introduction"} {subsection "What is {melt}?"} {paragraph "Motivation"} {latex} is great to format text. {ocaml} is great to program. What if you want to program {latex} documents using the {ocaml} syntax and type system? Then you can use {melt}. Let's see how we can produce the following: {display "Let $X {subset} \{1, 2, 3\}$."} With {latex}, this is easy: {display "<#Let $X \subset \{1, 2, 3\}$.#>"} What does it mean to program this in {ocaml}? Let's assume that you have some {latexlib} library providing the following functions: <#t#> which converts a string to {latex} text, <#m#> which converts a string to {latex} math, some basic {latex} macros and <#c#> which concatenates a list of {latex} expressions. Our example may then be encoded like this: {display "<%c [ t "Let "; m "X"; subset; lbrace; m "1, 2, 3"; rbrace; t "." ]%>"} This is much more verbose than the original {latex} code! The {melt} pre-processor allows lighter syntax: {display "<#"Let $X {subset} \{1, 2, 3\}$."#>"} Note how close this is to the {latex} syntax. The main differences are: usage of double quotes to enter {emph "text"} mode and usage of braces to enter {emph "code"} mode. The code mode, here, is used for command <#subset#>, which is an {ocaml} value of {latex} type. {paragraph "What is {melt}?"} {melt} allows you to write {latex} documents using {ocaml}. It is composed of the {latexlib} library for {ocaml}, the {melt} preprocessor, the {melt} tool, and the {meltlib} library. The {latexlib} library provides an {ocaml} interface to {latex}. It allows to create {latex} values in text or math mode and to concatenate them. It defines basic {latex} commands as {ocaml} values, such as <#subset#>. It is possible to write an entire document using only the {latexlib} library, but the syntax of {ocaml} is awful for this purpose, and the document quickly becomes an awful, unreadable mess. The {melt} preprocessor provides a much lighter syntax, allowing the user to easily interleave {latex} values and {ocaml} code. The {meltlib} library contains various tools to glue things together. In particular, it contains functions to easily include {mlpost} pictures. The {melt} tool takes a {melt} program and compiles it into a {postscript} or a {pdf} document. It runs the preprocessor if needed, compiles the program, executes it to produce a {latex} program, and then runs {latex} to produce the final document. {subsection "Getting Started"} A basic {melt} program, <#hello.mlt#>, looks like this: {listing "<#emit (document "Hello, world!")#>"} Let's see how to compile this document, and how does it work. {paragraph "Compiling Using the {melt} Tool."} You can compile <#hello.mlt#> in one command using the {melt} tool: {listing "<#melt hello.mlt#>"} This produces a file <#hello.ps#> containing the text ``Hello, world!''. You can produce a {pdf} file instead, using the <#-pdf#> option. {paragraph "Compiling by Hand."} Instead of using the {melt} tool, you can apply the preprocessor yourself: {listing "<#meltpp hello.mlt -o hello.ml -open Latex -open Melt#>"} This produces a file <#hello.ml#> which looks like this: {listing "<%open Latex;; open Melt;; emit (document (mode T ((text "Hello, world!"))))%>"} As you can see, the string <%"Hello, world!"%> is no longer a string but a value of type <%Latex.t%>. You can then compile this {ocaml} program. Once executed, it will produce a file <#hello.tex#> looking like this: {listing "<#\documentclass{article} \begin{document} Hello, world! \end{document}#>"} You can compile this file using <#latex#> or <#pdflatex#>. {paragraph "Understanding the Code."} The <#emit#> function of the {meltlib} library takes a value of type <#Latex.t#>. Values of this type describe {latex} abstract syntax trees (ASTs), {ie}, pieces of {latex} documents. The function writes this AST into the file <#hello.tex#>. What we want to emit is a full {latex} document. The <#document#> function of the {latexlib} library takes a body, of type <#Latex.t#>, and returns another value of type <#Latex.t#>. The returned AST contains the document class, the <#document#> environment, the author and so on. To produce the body of the document, we use the {melt} preprocessor. In a {melt} document, double quotes do not create values of type <#string#> but values of type <#Latex.t#>. So, here, <#"Hello, world!"#> is not a <#string#> but a piece of {latex} AST that we can give to the <#document#> function. {paragraph "Text and Math Modes."} You can insert math formulas using the dollar delimiters <#$#{cdots}#$#>, as in {latex}: {listing "<#"Assume $x+y=42$."#>"} This will produce: {display "Assume $x+y=42$."} The word ``Assume'', as well as the ending dot, are printed in {emph "text"} mode, whereas the math formula is printed in {emph "math"} mode. You enter text mode using double quotes <#"#{cdots}#"#>, and you enter math mode using dollars <#$#{cdots}#$#>. Note that you can enter math mode directly: {listing "<#emit (document $x+y=42$)#>"} You can also enter text mode while in math mode: {listing "<#$x+y=42 " but " z+t=69$#>"} This will produce: {display $x+y=42 " but " z+t=69$} These modes can be nested arbitrarily, but do not abuse this feature as your code will become less readable. {paragraph "Code Mode."} The third mode is called {emph "code"} mode. It is introduced using round brackets delimiters <#{#{cdots}#}#>. It allows to insert an {ocaml} value of type <#Latex.t#>. In particular, this is useful to write macros: {listing "<#let p = $3.141592$ in emit (document "{pi} is {p}.")#>"} This will produce: {display (let p = $3.141592$ in "{pi} is {p}.")} <#pi#> is a value of type <#Latex.t#> which is defined in the <#Latex#> module. In code mode, you can insert {ocaml} code of any complexity: {listing "<#$1+2+3 = {latex_of_int (1+2+3)}$#>"} This will produce: {display $1+2+3 = {latex_of_int (1+2+3)}$} The code in code mode is also preprocessed. This means that you can nest code, math and text modes arbitrarily. For example: {listing "<#"This {emph "word"} is emphasized."#>"} This will produce: {display "This {emph "word"} is emphasized."} {paragraph "Verbatim Mode."} The last mode is called {emph "verbatim"} mode. It can be used to insert text that should not be parsed, such as code listing{footnote "It is {emph "heavily"} used in the source of this document, which is of course written using {melt}."}. Here is an example: {listing "<#"Here is some code: <>"#>"} This will produce: {display "Here is some code: <>"} As you can see, the code between the <#<<#{cdots}#>>#> delimiters is not preprocessed: the double quotes and dollars are left as it. Moreover, every symbol is translated into the latex command <#symbol#> so it can be printed correctly. Spaces and new lines are also translated. To sum up, the text you write in verbatim mode will be printed verbatim{footnote "This is no coincidence."}. Note that the <#symbol#> command of {latex} often does not work well unless you use a <#tt#> font. The above example should be rewritten: {listing "<#"Code: {texttt "<>"}"#>"} This will produce: {listing "Code: {texttt "<>"}"} Also note that the verbatim mode can only be used in text mode. If you write <#<<#> in math mode, this will produce $<<$, and in code mode this will produce a syntax error from the {ocaml} compiler or a quotation if you use the {camlp4} syntax extension. The verbatim mode has other features such as delimiter selection, function selection and antiquotations. They will be described later in this document. {section ~label: lbl_melt_distribution "The {melt} Distribution"} The {melt} distribution contains the {latexlib} library, the {melt} preprocessor, the {meltlib} library, the {melt} tool, and this documentation. {subsection "Download"} The {melt} distribution can be found on OcamlForge: {listing "<#http://melt.forge.ocamlcore.org/#>"} Extract the archive wherever you want to obtain the <#melt#> directory. {subsection "Pre-requisites"} You need the OCaml compiler. Version 3.09 is enough, maybe some previous versions will work too. Version 3.10.2 is needed if you want to compile using Ocamlbuild. Version 3.11 is needed if you want to be able to use native plugins for the Melt Preprocessor. To compile Melt documents you need a {latex} distribution. To compile Melt documents which use Mlpost figures you need the Mlpost library. Versions from 0.6 to 0.7.4 are compatible. You will also need its dependencies, such as Metapost and the <#context#> package (Ubuntu, Debian, ...). Mlpost can be found at: {listing "<#http://mlpost.lri.fr#>"} You can compile and use Melt without Mlpost, but you will need to compile your Melt documents using the <#-no-mlpost#> option. If you later install Mlpost and want to use it with Melt you will have to recompile Melt. {subsection "Configure"} The configuration tool is automatically launched the first time you run make. You can rerun it at any time by removing the Config file and running make again, or by running the following command in the <#melt#> directory: {listing "<#ocaml configure.ml -i#>"} The -i option activates interactive mode. If you don't use it, default values will be used. You can also edit the <#Config#> file by hand. {subsection "Compile"} Just enter the <#melt#> directory and run: {listing "<#make#>"} {subsection "Install"} Just enter the <#melt#> directory and run: {listing "<#make install#>"} You might have to add <#sudo#> at the beginning if do not have the right permissions on the installation directories. {subsection "Uninstall"} Just enter the <#melt#> directory and run: {listing "<#make uninstall#>"} Be careful not to change the configuration in the <#melt#> directory between installing and uninstalling. {section "The {latexlib} Library"} The {latexlib} library is composed of a kernel, which allows to describe low-level {latex} ASTs, and of basic function definitions built on top of this kernel. {subsection "Using the Library"} {subsubsection "Compiling the Library"} The library is automatically compiled when you compile the {melt} distribution (see Section~{ref_ lbl_melt_distribution}). {subsubsection "Installing the Library"} The library will automatically be installed when you install the {melt} distribution. It will normally be installed in the {ocaml} library directory, which you can find using the command <#ocamlc -where#>, under the <#melt#> subdirectory. The following files should be copied there: {listing "<#latex.a latex.cmi latex.cma latex.cmxa#>"} To uninstall the library, simply delete these files or uninstall the {melt} distribution (see Section~{ref_ lbl_melt_distribution}). {subsubsection "Compiling a Program Which Uses the Library"} At compile-time, the {ocaml} compiler needs to know where to find the interface <#latex.cmi#>. If this file has been installed in the default {ocaml} library directory, {ocaml} will find it automatically. Else, you need to include the directory using the <#-I#> option. For example, to compile <#hello.ml#> if the library has been installed in the <#melt#> subdirectory of the default directory: {listing "<#ocamlc -c -I +melt hello.ml#>"} At link-time, the {ocaml} compiler also needs to know that the archive <#latex.cma#>, along with its dependency <#str.cma#>, have to be linked with the program. Add all these archives in the command line, in the right order. Replace <#.cma#> with <#.cmxa#> if you use the native compiler. For example, to produce the <#hello#> bytecode executable: {listing "<#ocamlc -I +melt str.cma latex.cma hello.cmo -o hello#>"} {subsubsection ~label: lbl_latex_ocamldoc "{ocamldoc} Documentation"} The {ocamldoc} documentation is automatically genererated when you compile the {melt} distribution (see Section~{ref_ lbl_melt_distribution}). It contains the list and documentation of every functions and values of the library. Open its index file in your browser: {listing "<#_build/latex/latex.docdir/index.html#>"} {subsection "The Kernel"} {listing "<%type t (* the type of LaTeX abstract syntax trees *)%>"} The {latexlib} library allows you to build {latex} Abstract Syntax Trees (ASTs) from a small set of basic constructions: modes, concatenation, commands and environments. These ASTs can then be pretty-printed as {latex} document parts. This section details these basic constructions. Examples do not use the {melt} preprocessor: strings are not escaped. {subsubsection "Raw Text"} {listing "<%val text: string -> t%>"} The <%text%> function makes an AST from raw {latex} code. Normally, you only use it without any special symbol such as <#$#>, <#{#>, <#}#> or <#\#>, unless you want to write something which is not supported by the library. Instead, use <%text%> to write text or math formulas: {listing "<%text "Hello everyone." text "1 + 2 = 5"%>"} AST parts produced by <%text%> are printed simply by printing the string given as argument. {subsubsection "Modes"} {listing "<%type mode = M | T | A val mode: mode -> t -> t%>"} The <%mode%> function takes an AST and sets its {emph "mode"}: {itemize [ "<%M%> for math mode;"; "<%T%> for text mode;"; "<%A%> for any mode."; ]} If the argument already had a mode, it is converted. Math mode is converted to text mode using dollars <#$ $#> while text mode is converted to math mode using <#mbox#>. If the old or the new mode is <%A%>, no conversion is made. For instance, <%mode T (text "Some text.")%>, when used in text mode, will be printed as <#Some text.#> (no conversion is needed) but when used in math mode, it will be printed as <#\mbox{Some text.}#>. Similarly, <%mode M (text "1 + 2 = 5")%>{footnote "Please note that {melt} does not ensure that the contents of your document makes sense."}, when used in text mode, will be printed as <#$1 + 2 = 5$#> but when used in math mode, it will be printed as <#1 + 2 = 5#>. Usually, the <%text%> and <%mode%> functions are used together. The <%text%> function may be used without <%mode%> if the raw {latex} part does not need a mode (for instance, it is usable in any mode, or it is used in a context when the mode makes no sense). {subsubsection "Concatenation"} {listing "<%val concat: t list -> t%>"} The <%concat%> function takes a list of ASTs and concatenate them in the given order. If a mode is given to the concatenation (using <%mode T (concat [ ... ])%> for instance), components of the list with a different mode are converted. {subsubsection "Commands and Environments"} {listing "<%val command: ?packages:(string * string) list -> string -> ?opt:mode * t -> (mode * t) list -> mode -> t%>"} Usage: <%command ~packages name ~opt arguments mode%> The <%command%> function produces the application of a {latex} {emph "command"}, i.e. a backslash <#\#>, followed by the name of the command, followed (if any) by the parameters of the command in braces <#{ }#>. The <%packages%> optional parameter is used to specify which packages (and their options as the second element of the pair) must be added to the prelude of the document when the command is used. The <%document%> function of the library will scan all the AST to list these packages and print the prelude accordingly. If you do not use the <%document%> function to produce your document, the <%packages%> parameter will have no effect. The <%name%> parameter is the name of the command, for instance <#lambda#> or <#texttt#>. The <%opt%> optional parameter can be used to provide an optional argument to the command, which will be printed in brackets <#[ ]#> before the other arguments. The mode is the mode in which the argument will be printed. The <%arguments%> parameter is the list of arguments which are printed in braces. Their respective mode is the mode in which they will be printed. The <%mode%> parameter is the mode of the resulting command, as if you applied the <%mode%> function to the resulting AST (which is, thus, not needed). {listing "<%val environment: ?packages:(string * string) list -> string -> ?opt:mode * t -> ?args:(mode * t) list -> mode * t -> mode -> t%>"} Usage: <%environment ~packages name ~opt ~args main_arg mode%> The <%environment%> function is similar to the <%command%> function, except that it produces {emph "environments"} instead of commands. An environment begins with <#\begin{...}#> and finishes with <#\end{...}#>, and has a main argument <%main_arg%> which is printed between the two. It may still, however, have an optional parameter <%~opt%>, and additional arguments <%~args%> which are printed in braces after the <#\begin#> command. In a typical {melt} document, you will not use <%command%> and <%environment%> very often. Indeed, there is a chance that the command or the environment you need has already been encoded in the library as an {ocaml} value. Here are some examples which are taken from the implementation of the library: {listing "<%let lambda = command "lambda" [] M let texttt x = command "texttt" [T, x] T let displaymath x = environment "displaymath" (M, x) T let includegraphics filename = command ~packages: ["graphicx", ""] "includegraphics" [ A, filename ] T%>"} {subsubsection "Printing the AST"} {listing "<%val to_buffer: ?mode: mode -> Buffer.t -> t -> unit val to_channel: ?mode: mode -> out_channel -> t -> unit val to_file: ?mode: mode -> string -> t -> unit val to_string: ?mode: mode -> t -> string%>"} These functions allow you to print a {latex} AST (i.e. a value of type <%Latex.t%>) as {latex} code. Function <%to_buffer%> prints into a buffer of the standard library, function <%to_channel%> prints into a channel of the standard library (module <%Pervasives%>), function <%to_file%> takes a file name as argument and prints into this file (which is truncated if it already exists), and function <%to_string%> returns a new string containing the {latex} code. You can use these functions to print any AST, whether it was created from the <%document%> function or not. If you print an AST which was created using <%document%>, it can be compiled with <#latex#> or <#pdflatex#>. Not using <%document%> can be interesting if you only want to produce a part of your document using {melt}, and then include it in a {latex} document using the <#\input#> command. The {meltlib} library also contains a function <%emit%> which should be used instead if you are using the {melt} tool (see Section~{ref_ lbl_melt_tool}). {subsection "Pervasive Definitions"} The library provides several {latex} commands and environment as {ocaml} values, along with other handy functions. This section does not detail every of them; view the {ocamldoc} documentation for the full list (see Section~{ref_ lbl_latex_ocamldoc}). {subsubsection "References and Labels"} When you refer to other sections, figures, tables or items, you should use {emph "labels"}. If you write the index of the section directly (such as <#"Section~7"#>{footnote "Tilde <#~#> is a non-breakable space."}) and then change the order of sections, you will have to change this ``7'' everywhere in your code, and you might miss some of them. {listing "<%type label val label: ?name: string -> unit -> label val ref_: label -> t%>"} Function <%label%> creates a new label, and <%ref_%> makes reference to a label. However, this is not enough as the label must be placed at the position it references. In {latex}, labels can be placed anywhere, which often leads to errors. In {melt}, labels are placed on meaningful constructions: sections (including chapters, sections, subsections and subsubsections) and figures (including other floats). These constructions are available as functions of the {latexlib} library and they all have an optional argument <%~label%>. Here is an example, written using the {melt} preprocessor, of a section which refers itself: {listing "<%let lbl_intro = label () let intro = section ~label: lbl_intro "This is Section~{ref_ lbl_intro}."%>"} A good practice is to put all label declarations of your document (such as <%lbl_intro%>) in the same place, and use some consistent naming convention such as <%lbl_something%>. You can still place labels anywhere using function <%place_label%>: {listing "<%val place_label: label -> t%>"} However, this should only be used if you want to use some {latex} feature which is not implemented in {melt}, or if you want to implement a command or environment similar to <#section#> or <#figure#>. If you want to mix {latex} and {melt} files by <#\input#>ing <#.tex#> files produced by {melt} in your <#.tex#> documents, you will want to name your labels using the <%~name%> optional argument of the <%label%> function. This name corresponds to the argument of the <#\label#> command of {latex}. There are two possible reasons for this. Either the label has been placed in the {latex} code, and you want to refer to it in your {melt} code; or the label has been placed in the {melt} code, and you want to refer to it in your {latex} code. If you do not wish to use the labels of {melt} for some reason, it is easy to reimplement them in a way which is closer to {latex} labels: {listing "<%let label x = command "label" [A, x] A let ref_ x = command "ref" [A, x] A%>"} If you use the preprocessor, don't forget to escape double quotes (<#\"#>) as the command name is a <%string%> and not a <%Latex.t%>. {subsubsection "Verbatim"} The <%Latex.Verbatim%> module is very powerful, especially used in conjunction with the {melt} preprocessor (see Section~{ref_ lbl_meltpp}), as it allows: {itemize [ "to write text that will be printed verbatim (i.e. ``unchanged'');"; "to define pretty-printers of various languages;"; "to define your own ``mode''."; ]} The last feature will be detailed in Section~{ref_ lbl_meltpp}. {paragraph "Verbatim Functions"} In {melt}, a {emph "verbatim function"} is a function of type <%string -> Latex.t%>, i.e. a function that somehow converts a string to a {latex} AST. The <%Latex.Verbatim%> module provides several tools to build such function. Function <%Latex.Verbatim.verbatim%> is a verbatim function which converts all non-alphanumerical characters using the <#\symbol#> command of {latex}. This allows you to print {emph "any"} string without messing with {latex} special characters such as <#$#>, <#\#>, <#{#> or <#}#>. Moreover, characters such as <#+#> have a special meaning in {latex}. Spacing rules are applied to them. For instance, <#$1+1$#> is printed as $1+1$: space is added to make the formula more pretty. However, it is not convenient when you want to print a series of symbols, or a source code. The <%verbatim%> function solves this problem. Note, however, that the <#\symbol#> command of {latex} does not work with fonts other than <#tt#>, so you should usually apply <%texttt%> to the result. For instance, <%texttt (verbatim "$1+1$")%> is printed as <#$1+1$#>.{footnote "The <%Latex.Verbatim.verbatim%> function is more powerful than the {latex} <#\verb#> command and <#verbatim#> environments. The first reason is that these do not work everywhere, whereas the <#\symbol#> function works as long as you can use a <#tt#> font. The second reason is that <#\verb#> and <#verbatim#> do not do exactly the same thing, which means that you cannot directly replace one with the other."} You can build other verbatim functions using <%regexps%>: {listing "<%val regexps: (Str.regexp * (string -> t)) list -> (string -> t) -> string -> t%>"} Use the <%regexps%> function to apply a function to the parts of the string which match some regular expression. You can give several such functions along with their respective regular expressions, which are defined using the <%Str%> module of the standard library. The second argument is apply to parts which do not match any regular expression. This is the most general way of specifying verbatim functions that is provided by the library. If you need more, you can use other parser generators such as Ocamllex with Ocamlyacc or Menhir. The second function is <%keywords%>: {listing "<%val keywords: ?apply: (t -> t) -> string list -> string -> t%>"} This is a particular instance of <%regexps%> which allows you to quickly build a verbatim function which simply applies <%~apply%> to all occurences of a list of words. For instance, <%keywords ["let"; "in"]%> is a verbatim function which will apply <%textbf%> (bold font) to all occurences of <#let#> and <#in#>. The last function is <%pseudocode%>: {listing "<%val pseudocode: ?trim: (string -> string) -> ?id_regexp: Str.regexp -> ?kw_apply: (t -> t) -> ?id_apply: (t -> t) -> ?rem_apply: (string -> t) -> ?keywords: string list -> ?symbols: (string * t) list -> ?keyword_symbols: (string * t) list -> ?underscore: Str.regexp -> string -> t%>"} This function is a compromise between <%regexps%>, which can feel a bit heavy because of regular expressions, and <%keywords%>, which can only handle one kind of keywords as only one function can be applied. On the other hand, <%pseudocode%> can handle many kinds of replacement rules without requiring the use of regular expressions. What <%keywords%> does is first seperate {emph "identifiers"}, which are substrings matching <%id_regexpr%>, from the rest of the string. Identifiers can then be {emph "keywords"} if they match a string of the <%keywords%> argument; in this case, <%kw_apply%> is applied to them. Identifiers can also be {emph "keyword symbols"}, which are keywords which will be replaced by a symbol. They are defined by the list of couples <%keyword_symbols%>. For instance, use the couple <%("nothing", emptyset)%> to replace each occurences of ``nothing'' by {emptyset}. Identifiers which are not keywords nor keyword symbols are just identifiers, and <%id_apply%> is applied to them. Identifiers are split according to the <%underscore%> argument, which matches the underscore character by default. The first part is displayed normally, but the other parts are treated as indexes separated by commas. For instance, <#hello_42_z#> becomes <:Verbatim.pseudocode:>. Each part itself is checked to see if it is a keyword or a keyword symbol, which allows to replace, for instance, <#hello_nothing#> by <:verbatim_example_nothing:>. Parts of the string which are not identifiers are then scanned for {emph "symbols"}, defined using the <%symbols%> argument in a similar fashion than keyword symbols. For instance, this can be used to replace <#->#>, which is not an identifier, to an arrow {rightarrow}. Finally, everything which is not a keyword nor a symbol is replaced by applying <%rem_apply%>. The string given to a pseudocode verbatim function is {emph "trimmed"} before being processed: empty lines at the beginning and at the end of the string are deleted. This allows you to start your code at the beginning of a new line of your source code, which is prettier. You can change this behavior by changing the <%trim%> argument, which will be applied instead of the default trimming function. {paragraph "Example: Boolean Formulas"} Let's use <%pseudocode%> to take boolean formulas such as: {listing "<# A /\ B \/ (C_1 xor C_2) <=> (D ==> E_1 xand E_2) #>"} and print them like this: {display "<:verbatim_example_bool:+ A /\ B \/ (C_1 xor C_2) <=> (D ==> E_1 xand E_2) +>"} Operators <#xor#> and <#xand#> are identifiers which should be viewed as keywords printed as symbols, so we define them using the <%~keyword_symbols%> argument. Operators <#/\#>, <#\/#>, <#<=>#> and <#==>#> are not identifiers, they are simply symbols, so we define them using the <%~symbols%> argument. The result is the following function: {listing "<% let boolean_formula = Verbatim.pseudocode ~symbols: [ "/\\\\", land_; "\\\\/", lor_; "<=>", iff; "==>", rightarrow_; "<==", leftarrow_; ] ~keyword_symbols: ["xor", oplus; "xand", otimes] %>"} {paragraph "Example: OCaml Pretty-Printer"} Here is the verbatim function which is applied to all OCaml examples of this user manual: {listing "<% let verbatim_keywords = Latex.Verbatim.keywords ~apply: (fun _ -> texttt (symbolc '_')) ["_"] let ocaml_code_base x = Verbatim.pseudocode ~trim: (fun s -> s) ~underscore: (Str.regexp "__") ~id_apply: (fun i -> textsf (verbatim_keywords (to_string i))) ~kw_apply: (fun x -> textbf (textsf x)) ~rem_apply: (fun s -> texttt (Latex.Verbatim.verbatim s)) ~keywords: ["let"; "in"; "val"; "fun"; "type"] ~symbols: ["->", rightarrow] x let ocaml_code x = Verbatim.regexps [ Str.regexp "\"\\\\([\\\\]\"\\\\|[^\"]\\\\)*\"", (fun s -> texttt (Latex.Verbatim.verbatim s)); Str.regexp "(\\\\*\\\\([^*]\\\\|\\\\*[^)]\\\\)*\\\\*)", (fun s -> textit (text s)); ] ocaml_code_base (Verbatim.trim ['\n'] x) %>"} Function <%ocaml_code%> first deals with string constants and comments using regular expressions. Note that this is not perfect, as it does not handle double quotes in comments. The rest of the code is processed by <%ocaml_code_base%>, which defines how keywords, symbols and identifiers should be printed. Several techniques are used. {itemize [ "We set <%~id_apply%> and <%~kw_apply%> to print identifiers and keywords using a sans serif font (using <%textsf%>)."; "OCaml identifiers tend to use underscores a lot, but <%pseudocode%> uses underscores to parse indices. We change this behavior by changing the <%~underscore%> optional parameter."; "Now that underscores are normal parts of identifiers, we need to print them correctly. So we change how keywords are printed, by using an auxiliary verbatim function <%verbatim_keywords%> which views underscores inside keywords, as keywords which should be printed as <#tt#> underscores (default underscore is _, and <#tt#> underscore is <#_#> which is prettier). Note that we could have simply used <%Latex.Verbatim.verbatim%> if identifiers were printed using a <#tt#> font instead of a sans serif font."; "Function <%ocaml_code_base%> will be applied to each part of the original string which is not a string constant. For instance, when we apply <%ocaml_code%> to <#print "this";#>, <%ocaml_code_base%> is actually applied twice: to <#"print "#> and to <#";"#>. This means that both these strings are trimmed, which is not the expected behavior. So we disable trimming by changing the <%~trim%> optional parameter, and we trim the string ourself in <%ocaml_code%> using <%Verbatim.trim%>."; ]} {section ~label: lbl_meltpp "The Melt Preprocessor"} {todo "- modes - pragmas - verbatim (relire subsubsection verbatim) - command line options - plugins"} {section ~label: lbl_meltpp "The {meltlib} Library"} {subsection "Using the Library"} {subsubsection "Compiling the Library"} The library is automatically compiled when you compile the {melt} distribution (see Section~{ref_ lbl_melt_distribution}). {subsubsection "Installing the Library"} The library will automatically be installed when you install the {melt} distribution. It will normally be installed in the {ocaml} library directory, which you can find using the command <#ocamlc -where#>, under the <#melt#> subdirectory. The following files should be copied there: {listing "<#melt.a melt.cmi melt.cma melt.cmxa#>"} To uninstall the library, simply delete these files or uninstall the {melt} distribution (see Section~{ref_ lbl_melt_distribution}). {subsubsection "Compiling a Program Which Uses the Library"} At compile-time, the {ocaml} compiler needs to know where to find the interface <#melt.cmi#>. If this file has been installed in the default {ocaml} library directory, {ocaml} will find it automatically. Else, you need to include the directory using the <#-I#> option. For example, to compile <#hello.ml#> if the library has been installed in the <#melt#> subdirectory of the default directory: {listing "<#ocamlc -c -I +melt hello.ml#>"} At link-time, the {ocaml} compiler also needs to know that the archive <#melt.cma#>, along with its dependencies <#latex.cma#>, <#str.cma#> and <#mlpost.cma#> (if you compiled {melt} with {mlpost}), have to be linked with the program. Add all these archives in the command line, in the right order. Replace <#.cma#> with <#.cmxa#> if you use the native compiler. For example, to produce the <#hello#> bytecode executable: {listing "<#ocamlc -I +melt -I +mlpost mlpost.cma str.cma latex.cma melt.cma hello.cmo \ -o hello#>"} Note that {mlpost} itself may require some other dependencies. {subsubsection ~label: lbl_latex_ocamldoc "{ocamldoc} Documentation"} The {ocamldoc} documentation is automatically genererated when you compile the {melt} distribution (see Section~{ref_ lbl_melt_distribution}). It contains the list and documentation of every functions and values of the library. Open its index file in your browser: {listing "<#_build/melt/melt.docdir/index.html#>"} {subsection "......"} {todo "library documentation"} {section ~label: lbl_melt_tool "The Melt Tool"} {todo "- command line arguments - emit"} ") let () = emit (document ~title: "Melt User Manual" ~options: [ `A4paper ] ~packages: [ "fullpage", ""; ] ~date: "" doc) (* Local Variables: compile-command: "melt doc.mlt && evince doc.ps" End: *) melt-1.4.0/bench/lines.mlt0000644000175000017500000000261711661167412014733 0ustar romainromain(* This example shows how to make a verbatim mode which number code lines. You may then reference a specific line in a safe way (i.e. if the line moves the reference is updated). *) let rec list_mapi ?(acc = []) ?(n = 0) f = function | [] -> List.rev acc | x :: r -> list_mapi ~acc: (f n x :: acc) ~n: (n + 1) f r let current_line = variable 0 let number_lines verb_fun s = let lines = list_mapi (fun i line -> array_line [ latex_of_int (i + 1); "{set current_line (i + 1)}{verb_fun line}"; ]) (Verbatim.split_lines (Verbatim.trim ['\n'] s)) in array [ `R; `Vert; `L ] lines let pseudo_caml x = textsf (Verbatim.keywords [ \"let\"; \"in\" ] x) let caml x = " {par} {addvspace (`Cm 0.5)} {number_lines pseudo_caml x} {par} {addvspace (`Cm 0.5)} " let new_line_label () = variable 0 let label_line var = get current_line (fun x -> set var x) let ref_line var = final var latex_of_int let lbl_toto = new_line_label () let lbl_bli = new_line_label () let () = emit (document " Here is some code. Line~{ref_line lbl_toto} is toto. <:caml:# let f x = x + 1 let g x = x + 2 let toto =#{label_line lbl_toto}# let tata = f 1 + f 2 in let tutu = f 3 + f 4 in tata + tutu let bli =#{label_line lbl_bli}# let blo = let bla = 2 in bla + 3 in blo + 5 #> Is is beautiful or what? Line~{ref_line lbl_bli} is bli. ") melt-1.4.0/bench/specials.mlt0000644000175000017500000000157111661167412015422 0ustar romainromainlet x = $x$ let () = emit begin document "{section "Without backslashes"} Some special characters in text mode: sharp #, as in Spec#, underscore _, as in some_dummy_example, []@()/ are already ok. A blank line yields a new paragraph: See? Percent does not create a comment: %. More: %%%%%. And now in math mode: $%$. More: $%%%%%$. {section "With backslashes"} The backslash itself \\ yields a new line. In math mode: braces $\{$ and $\}$, dollar $\$$, double quote $\"$ In text mode: double quote \", dollar \$, braces \{ and \} Ampersand in text \& and in math $\&$ Space escaping (text): . . (2 spaces) and .\ \ . (2 spaces backslashed) Space escaping (math): $. .$ (2 spaces) and $.\ \ .$ (2 spaces backslashed) {section "Blocks, indices, exponents"} Index: {index x $n+1$} Exponent: {exponent x $n+1$} Nested: {exponent (index $f$ (exponent $n+1$ $42$)) $xyz$}" end melt-1.4.0/bench/bench.ml0000644000175000017500000000672511661167412014520 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Printf let files = Queue.create () let maxlen = ref 0 let speclist = [] let anon_fun x = maxlen := max !maxlen (String.length x); Queue.add x files let usage_msg = "ocaml bench.ml " let () = Arg.parse speclist anon_fun usage_msg; if Queue.is_empty files then begin Arg.usage speclist usage_msg; exit 0 end let file opt f = if not (Sys.file_exists f) then begin eprintf "Error: File not found: %s\n" f; exit 2 end; let cwd = Sys.getcwd () in let log = sprintf "%s/%s.bench.log" cwd (Filename.basename f) in if Sys.file_exists log then Sys.remove log; let cmd = sprintf "%s/../_build/melt/tool.byte -P %s/../_build/bench/plugs \ -I %s/../_build/latex -I %s/../_build/melt \ -latop %s/../_build/latop/latop.byte \ -meltpp %s/../_build/meltpp/main.byte \ %s \ %s 2>> %s >> %s" cwd cwd cwd cwd cwd cwd opt f log log in let dots = String.make (!maxlen - String.length f + 5) '.' in match Sys.command cmd with | 0 -> printf "%s %s: OK\n%!" f dots; Sys.remove log | n -> printf "%s %s: FAILED (code %d)\n%!" f dots n let () = printf "\nTesting melt examples by compiling to .ps...\n%!"; Queue.iter (file "-ps") files; printf "\nTesting melt examples by compiling to .pdf...\n%!"; Queue.iter (file "-pdf") files; melt-1.4.0/bench/Makefile0000644000175000017500000000024111661167412014532 0ustar romainromaindefault all check bench test: ocaml bench.ml *.mlt %.bench %.check: ocaml bench.ml $*.mlt %.test: %.check evince $*.ps .PHONY: default all check bench testmelt-1.4.0/bench/final-package.mlt0000644000175000017500000000031511661167412016274 0ustar romainromainlet c = variable 0 (* This is tricky because [box_] calls [set] to add the [latexsym] package, but [set] are not valid in [final]s. *) let body = final c (fun _ -> box_) let () = emit (document body) melt-1.4.0/bench/plugin.mlt0000644000175000017500000000021111661167412015103 0ustar romainromain##plugin quot let () = emit (document "Verbatim test: <:test:"this is an anti-quotation"< and this is a quotation>>") melt-1.4.0/melt/0000755000175000017500000000000011661167412012757 5ustar romainromainmelt-1.4.0/melt/melt.mli0000644000175000017500000001203111661167412014420 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (** Unification of [Mlpost], [Latex] and the preprocessor. *) (** Emit a LaTeX file. *) val emit: ?file: string -> Latex.t -> unit (** This is basically the same than [Latex.to_file] except that there is a default file name [base.tex] where [base] is computed in the same way than [base] in the [mlpost] function. *) module Verbatim: sig (** Verbatim modes for the Melt pre-processor. *) (** These modes are the same as the ones in the [Latex.Verbatim] module, except that they work with the Melt pre-processor. *) type melt_verbatim_string = [ `V of string | `C of Latex.t | `M of Latex.t | `T of Latex.t ] list type latex_verbatim_function = string -> Latex.t type melt_verbatim_function = melt_verbatim_string -> Latex.t val convert: latex_verbatim_function -> melt_verbatim_function (** Convert a verbatim function of the [Latex] module to a function usable with the Melt pre-processor. The original function is applied to each quotations; anti-quotations are left as it, and the resulting list is concatenated. *) (** {2 Conversion of [Latex.Verbatim]} *) val trim: char list -> melt_verbatim_string -> melt_verbatim_string (** The [trim] function will only be applied at the beginning of the first [`V] item and at the end of the last [`V] item. *) val split_lines: melt_verbatim_string -> melt_verbatim_string list val verbatim: melt_verbatim_function val regexps: (Str.regexp * (string -> Latex.t)) list -> (string -> Latex.t) -> melt_verbatim_function val keywords: ?apply: (Latex.t -> Latex.t) -> string list -> melt_verbatim_function val pseudocode : ?trim: (melt_verbatim_string -> melt_verbatim_string) -> ?id_regexp: Str.regexp -> ?kw_apply: (Latex.t -> Latex.t) -> ?id_apply: (Latex.t -> Latex.t) -> ?rem_apply: (string -> Latex.t) -> ?keywords: string list -> ?symbols: (string * Latex.t) list -> ?keyword_symbols: (string * Latex.t) list -> ?underscore: Str.regexp -> melt_verbatim_function end include Mlpost_specific.Signature module Arg : sig (** simple command line parameters handling *) val bool : Latex.t -> bool (** [bool "text"] is true iff the command line contains "-text" *) val int : ?default:int -> Latex.t -> int (** [int "text"] is n if the command line contains "-text n". The value defaults to 0 if unspecified *) val float : ?default:float -> Latex.t -> float (** [float "text"] is n if the command line contains "-text n" The value defaults to 0. if unspecified *) val text : ?default:Latex.t -> Latex.t -> Latex.t (** [float "text"] is [Latex.text s] if the command line contains "-text s" The value defaults to the empty string if unspecified *) val mode : [ `Pdf | `Ps | `Cairo | `Mps ] (** [mode] reflects the mode in which [melt] is ran. [`Pdf] for [-pdf] [`Ps] for [-ps] [`Cairo] for [-cairo] [`Mps] for [-mps] *) end melt-1.4.0/melt/mlpost_on.ml0000644000175000017500000001025411661167412015325 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) module type Signature = sig (** Part of [Melt] which uses [Mlpost]. *) val compiled_with_mlpost: bool (** The value of [compiled_with_mlpost] is [true]. *) (** Convert some LaTeX into a picture. *) val picture_of_latex: Latex.t -> Mlpost.Picture.t (** Emit a figure to use it in a LaTeX document. *) val mlpost: ?mode: Melt_common.mode -> ?file: string -> Mlpost.Command.t -> Latex.t (** The default value of [~mode] is the mode specified via the command line (either to the melt tool or directly to the executable). The [~file] parameter may be used if you want to specify the file name used for the figure Metapost script. Otherwise, a default name is chosen. This default name is [base.melt.figureN.ext], where [base] is the executable base name (can be overriden with the [-name] option on the command line), [N] is the figure index and [ext] is [mps] if [-pdf] is [true] or [1] otherwise. *) module Beamer : sig include Latex.BEAMER val mlpost: ?only: Latex.Beamer.overlays_spec list -> ?mode: Melt_common.mode -> ?file: string -> Mlpost.Command.t -> Latex.t end end let compiled_with_mlpost = true open Melt_common let picture_of_latex l = try Mlpost.Picture.tex (Latex.to_string l) with (Invalid_argument txt) -> Mlpost.Picture.tex ("Cannot compile Mlpost figure. Reason: " ^ (Latex.to_string (Latex.texttt (Latex.Verbatim.verbatim txt)))) let mlpost_gen includegraphics ?(mode = mode) ?file f = let file = match file with | None -> next_name () | Some file -> file in let ext = match mode with | `Pdf -> ".mps" | `Ps -> ".1" | `Cairo -> ".pdf" | `Mps -> ".mps" in let full_name = file ^ ext in Mlpost.Metapost.emit file f; includegraphics (Latex.text full_name) let mlpost = mlpost_gen Latex.includegraphics module Beamer = struct include Latex.Beamer let mlpost ?only = mlpost_gen (fun x -> Latex.Beamer.includegraphics ?only x) end melt-1.4.0/melt/melt_common.ml0000644000175000017500000000660011661167412015624 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) (* We don't use the Arg module in order not to force the user to handle the -pdf and -name options *) type mode = [ `Pdf | `Ps | `Cairo | `Mps ] let mode : mode = let m = ref `Ps in for i = 1 to Array.length Sys.argv - 1 do if Sys.argv.(i) = "-pdf" then m := `Pdf; if Sys.argv.(i) = "-ps" then m := `Ps; if Sys.argv.(i) = "-cairo" then m := `Cairo ; if Sys.argv.(i) = "-mps" then m := `Mps done; !m let rec no_extension f = try no_extension (Filename.chop_extension f) with Invalid_argument "Filename.chop_extension" -> f let name = let name = ref (no_extension (Filename.basename Sys.argv.(0))) in for i = 1 to Array.length Sys.argv - 2 do if Sys.argv.(i) = "-name" then name := Sys.argv.(i+1) done; !name let print_depends = let b = ref false in for i = 1 to Array.length Sys.argv - 1 do if Sys.argv.(i) = "-depends" then b := true done; !b let next_name = let cnt = ref 0 in fun () -> incr cnt; Printf.sprintf "%s-melt-figure%d" name !cnt (* The document may depend on other files than the .tex, for instance, Mlpost figures. This is a list of these files. *) let tex_dependencies: string list Latex.variable = Latex.variable [] melt-1.4.0/melt/melt.ml0000644000175000017500000001406511661167412014260 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Melt_common let print_tex_dependencies basefile depends = if print_depends then begin let file = basefile ^ ".depends" in (* We sort the dependencies so the order of the files does not effect the .depends file. *) let depends = List.sort String.compare depends in let ch = open_out file in List.iter (fun dep -> if Sys.file_exists dep then let hash = Digest.file dep in Digest.output ch hash else ()) depends; close_out ch end let emit ?(file = name ^ ".tex") x = let env = Latex.to_file file x in print_tex_dependencies file (Latex.get_in_env tex_dependencies env) let rec list_split_when f ?(acc = []) = function | [] -> raise Not_found | x :: r as l -> if f x then List.rev acc, l else let acc = x :: acc in list_split_when f ~acc r module Verbatim = struct type melt_verbatim_string = [ `V of string | `C of Latex.t | `M of Latex.t | `T of Latex.t ] list type latex_verbatim_function = string -> Latex.t type melt_verbatim_function = melt_verbatim_string -> Latex.t let convert f l = Latex.concat begin List.map begin function | `V s -> f s | `C a -> a | `M a -> Latex.mode Latex.M a | `T a -> Latex.mode Latex.T a end l end let rec split_verbs_begin first = function | [] -> first, [] | (`V v)::rem -> split_verbs_begin (first^v) rem | x -> first, x let split_verbs_begin = split_verbs_begin "" let rec split_verbs_end last = function | [] -> [], last | (`V v)::rem -> split_verbs_end (v^last) rem | x -> List.rev x, last let split_verbs_end l = split_verbs_end "" (List.rev l) let split_verbs l = let first, rem = split_verbs_begin l in let middle, last = split_verbs_end rem in first, middle, last let trim chars l = let first, middle, last = split_verbs l in let first = if middle = [] then `V (Latex.Verbatim.trim chars first) else `V (Latex.Verbatim.trim_begin chars first) in let last = `V (Latex.Verbatim.trim_end chars last) in first :: middle @ [last] let split_lines verb: melt_verbatim_string list = let rec f = function | `V s -> List.map (function Str.Text s -> `V s | Str.Delim s -> `V "\n") (Str.full_split (Str.regexp_string "\n") s) | x -> [x] in let rec split verb = try let a, b = list_split_when (fun x -> x = `V "\n") verb in a :: (split (List.tl b)) with Not_found -> [verb] in split (List.flatten (List.map f verb)) let verbatim = convert Latex.Verbatim.verbatim let regexps x y = convert (Latex.Verbatim.regexps x y) let keywords ?apply x = convert (Latex.Verbatim.keywords ?apply x) let pseudocode ?(trim = trim ['\n']) ?id_regexp ?kw_apply ?id_apply ?rem_apply ?keywords ?symbols ?keyword_symbols ?underscore s = let s = trim s in convert (Latex.Verbatim.pseudocode ~trim: (fun x -> x) ?id_regexp ?kw_apply ?id_apply ?rem_apply ?keywords ?symbols ?keyword_symbols ?underscore) s end include Mlpost_specific module Arg = struct open Latex let parameter_present name = let rec aux i = if i = Array.length Sys.argv then false else (aux (i+1)) || ( Sys.argv.(i) = ( "-" ^ (to_string name))) in aux 1 let parameter_value default f name = let rec aux i = if i = Array.length Sys.argv - 1 then default else if ( Sys.argv.(i) = ( "-" ^ (to_string name))) then f (Sys.argv.(i + 1)) else aux (i+1) in aux 1 let bool name = parameter_present name let int ?(default=0) name = parameter_value default int_of_string name let float ?(default=0.) name = parameter_value default float_of_string name let text ?(default=(text "")) name = parameter_value default (fun x -> text x) name let mode = Melt_common.mode end melt-1.4.0/melt/tool.ml0000644000175000017500000003243711661167412014277 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Printf (* From Totoconf *) exception Exec_error of int let try_finally f g = let result = try f (); with exn -> g (); raise exn in (g (): unit); result let exec_line cmd args = let c = String.concat " " (cmd::args) in let tmp = Filename.temp_file "configure_exec_line" ".out" in try_finally (fun () -> try match Sys.command (c ^ " > " ^ tmp) with | 0 -> input_line (open_in tmp) | n -> raise (Exec_error n) with End_of_file -> "") (fun () -> Sys.remove tmp) (* *) let files = Queue.create () let main_file = ref "" let mlpost = ref Melt.compiled_with_mlpost let ocamlbuild = ref true let native = ref false let final = ref true let link = ref true let dvi = ref false let pdf = ref false let ps2pdf = ref false let cairo = ref false let mps = ref false let quiet = ref false let continue = ref false let fake = ref false let bibtex = ref false let fast = ref false let clean = ref false let melt_dir = ref "_melt" let latex = ref None let meltpp = ref "meltpp" let latop = ref "latop" let mlpost_bin = ref "mlpost" let mlpost_no_prelude = ref false let classic_display = ref false (* -P includes for meltpp *) let plugin_includes = ref [] let meltpp_plugin_includes = ref "" let add_plugin_include x = plugin_includes := x :: !plugin_includes (* -I includes for the OCaml compiler *) let includes = ref [] let add_include x = includes := x :: !includes (* -L add links for latex *) let latex_link = ref [] let add_latex_link x = latex_link := x :: !latex_link let resto = ref "" let set_rest s = match !resto with | "" -> resto := s | r -> resto := r ^ " " ^ s let () = try let libmelt_dir = exec_line "ocamlfind" ["query"; "melt"; "2> /dev/null"] in add_include libmelt_dir with Exec_error _ -> add_include "+melt" let spec = Arg.align [ "-meltpp", Arg.Set_string meltpp, " Specify the location of the \ Melt pre-processor"; "-latop", Arg.Set_string latop, " Specify the location of latop"; "-mlpost", Arg.Set_string mlpost_bin, " Specify the location of the mlpost tool"; "-mlpost-no-prelude", Arg.Set mlpost_no_prelude, " Do not pass a -latex option to mlpost"; "-latex", Arg.String(fun cmd -> latex := Some cmd), " Specify the latex command to use"; "-P", Arg.String add_plugin_include, " Look for plugins in \ (this option is passed to the Melt pre-processor)"; "-I", Arg.String add_include, " Look for libraries in \ (this option is passed to the OCaml compiler)"; "-L", Arg.String add_latex_link, " Add a link to the path in the _melt directory"; "-classic-display", Arg.Set classic_display, " Call Ocamlbuild with -classic-display (do not work with Mlpost)"; "-no-mlpost", Arg.Clear mlpost, " Do not call mlpost, use ocamlbuild instead \ (or ocamlc if -no-ocamlbuild)"; "-no-ocamlbuild", Arg.Clear ocamlbuild, " Do not use Ocamlbuild"; "-no-final", Arg.Clear final, " Do not produce the PS or the PDF"; "-no-link", Arg.Clear link, " Do not create a symbolic link to the PS or PDF"; "-byte", Arg.Clear native, " Compile to byte code (default)"; "-native", Arg.Set native, " Compile to native code instead of bytecode"; "-dvi", Arg.Set dvi, " Produce a DVI instead of a PS"; "-ps", Arg.Clear pdf, " Produce a PS file (this is the default behavior)"; "-pdf", Arg.Set pdf, " Produce a PDF instead of a PS"; "-ps2pdf", Arg.Set ps2pdf, " Produce a PS, then convert it to PDF using ps2pdf"; "-cairo", Arg.Unit (fun () -> cairo := true; pdf := true), " Use the Cairo backend of Mlpost (implies -pdf)"; "-mps", Arg.Unit (fun () -> cairo := true; pdf := true), " Use the native Mps backend of Mlpost (implies -pdf)"; "-quiet", Arg.Set quiet, " Be quiet"; "-q", Arg.Set quiet, " Same as -quiet"; "-continue", Arg.Set continue, " Continue on errors"; "-k", Arg.Set continue, " Same as -continue"; "-fake", Arg.Set fake, " Do not actually execute commands"; "-n", Arg.Set fake, " Same as -fake"; "-bibtex", Arg.Set bibtex, " Use BibTeX"; "-fast", Arg.Set fast, " Do not call LaTeX again to get references right"; "-melt-dir", Arg.Set_string melt_dir, " Change the name used for \ the _melt directory"; "-clean", Arg.Set clean, " Remove the _melt directory and, if not -no-link, \ all symbolic links of the current directory linking into _melt \ (cleaning is done before anything else)"; "-version", Arg.Unit Melt_version.print, " Print version"; "--", Arg.Rest set_rest, " Pass the remaining arguments to the generated program"; ] let anon s = main_file := s; Queue.add s files let usage = "Usage: " ^ Filename.basename Sys.argv.(0) ^ " [options] [other_files] main_file\n All [other_files] will be copied in the _melt directory. In particular, this \ allows you to use other modules, libraries or Ocamlbuild plugins. Files \ with extension .mlt will be pre-processed, compiled and executed.\n" let cmd x = ksprintf begin fun s -> if not !quiet then printf "%s\n%!" s; if not !fake then let code = Sys.command s in if code <> 0 && not !continue then exit code end x let mlpost_version = ref "" let check_mlpost_version () = try mlpost_version := Totoconf.exec_line !mlpost_bin ["-version"] with | Totoconf.Exec_error _ -> () let mlpost_version_ge s = !mlpost_version = "current" || Totoconf.Version.ge !mlpost_version s let mlpost_version_le s = !mlpost_version <> "current" && Totoconf.Version.le !mlpost_version s let melt_to_ml f = let o = Filename.chop_extension f ^ ".ml" in cmd "%s%s -dir \"../\" -open Latex -open Melt %s -o %s" !meltpp !meltpp_plugin_includes f o let libopt lib = let dot_cma = if !native then ".cmxa" else ".cma" in if !mlpost then " -ccopt " ^ if !ocamlbuild then "\"-lib " ^ lib ^ "\"" else lib ^ dot_cma else if !ocamlbuild then " -lib \"" ^ lib ^ "\"" else " "^lib^dot_cma let ml_to_tex f = let bf = Filename.chop_extension f in let pdfo = if !pdf then " -pdf" else if mlpost_version_ge "0.7" then " -ps" else " -pdf" in let pdfeo = if !pdf then " -execopt \"-pdf\"" else "" in let nameo = " -name " ^ bf in let nameeo = " -execopt \"-name " ^ bf ^ "\"" in let ocamlbuildo = if !ocamlbuild then " -ocamlbuild" else "" in let nativeo = if !native then " -native" else "" in let latexlibo = libopt "latex" in let meltlibo = libopt "melt" in let mlpostlibo = if Melt.compiled_with_mlpost then libopt "mlpost" else "" in let strlibo = libopt "str" in let unixlibo = libopt "unix" in let ext = if !native then "native" else "byte" in let ocamlc_includes = match !includes with | [] -> "" | l -> " -I " ^ String.concat " -I " l in let ocamlbuild_includes = match !includes with | [] -> "" | l -> let includes = "-I," ^ String.concat ",-I," l in " -cflags " ^ includes ^ " -lflags " ^ includes in let mlpost_includes = match !includes with | [] -> "" | l -> " -ccopt \"" ^ (if !ocamlbuild then ocamlbuild_includes else ocamlc_includes) ^ "\"" in let classicdisplayo = if !classic_display then " -classic-display" else "" in let mlpost_preludeo = if !mlpost_no_prelude then "" else let prelude_file = bf ^ ".tex" in if Sys.file_exists prelude_file then " -latex " ^ prelude_file else "" in if !mlpost then cmd "%s -v%s%s%s%s%s%s%s%s%s%s%s%s %s" !mlpost_bin mlpost_preludeo (if mlpost_version_ge "0.7" && mlpost_version_le "0.7.1" then classicdisplayo else "") mlpost_includes pdfo (" -execopt \"" ^ (String.escaped !resto) ^ "\"") (if !cairo then " -cairo -execopt \"-cairo\"" else if !mps then " -mps -execopt \"-mps\"" else pdfeo) ocamlbuildo nativeo strlibo latexlibo meltlibo nameeo f else if !ocamlbuild then cmd "ocamlbuild%s%s%s%s%s%s%s %s.%s --%s%s%s" classicdisplayo ocamlbuild_includes strlibo unixlibo latexlibo mlpostlibo meltlibo bf ext pdfo nameo !resto else begin cmd "ocaml%s%s%s%s%s%s%s %s -o %s.%s" (if !native then "opt" else "c") ocamlc_includes strlibo unixlibo latexlibo mlpostlibo meltlibo f bf ext; cmd "./%s.%s%s%s%s" bf ext pdfo nameo !resto end let handle_auxiliary_file f = if Filename.check_suffix f ".mlt" then melt_to_ml f let produce_final f = let bf = Filename.chop_extension f in let tex = bf ^ ".tex" in if not (Sys.file_exists tex) then begin Printf.eprintf "Error: cannot find file: \"%s\" (in the \"%s\" directory).\nMaybe the \"emit\" function has not been called on your document?\n%!" tex !melt_dir; exit 2 end; let add_link s = cmd "ln -fs ../%s %s" s s in List.iter add_link !latex_link; let latex = match !latex with | None -> if !ps2pdf then "latex" else if !pdf then "pdflatex" else "latex" | Some cmd -> cmd in let latex = latex ^ " -interaction nonstopmode -file-line-error -halt-on-error" in let latop = sprintf " | %s > /dev/null" !latop in cmd "%s %s%s" latex bf latop; if !bibtex then begin cmd "bibtex %s" bf; cmd "%s %s%s" latex bf latop end; if not !fast then cmd "%s %s%s" latex bf latop; if not !pdf && not !dvi then cmd "dvips %s" bf; if !ps2pdf then begin if !pdf || !dvi then cmd "dvips %s" bf; cmd "ps2pdf %s.ps" bf end let handle_main_file f = if Filename.check_suffix f ".mlt" || Filename.check_suffix f ".ml" then begin let ml = Filename.chop_extension f ^ ".ml" in ml_to_tex ml; end; if !final then produce_final f let produce_link f = let bf = Filename.chop_extension f in let o = if !pdf || !ps2pdf then bf ^ ".pdf" else if !dvi then bf ^ ".dvi" else bf ^ ".ps" in cmd "ln -f -s %s/%s %s" !melt_dir o o let chdir d = if not !quiet then if !fake then Printf.printf "cd %s\n%!" d else Printf.printf "melt: Entering directory `%s'\n%!" d; if not !fake then Sys.chdir d let make_temp_dir () = let dir = !melt_dir in cmd "mkdir -p %s" dir; Queue.iter begin fun f -> cmd "cp -f %s %s/%s" f dir f; end files; chdir dir let prefix s t = if String.length s > String.length t then false else String.compare s (String.sub t 0 (String.length s)) = 0 let do_clean () = let dir = !melt_dir in cmd "rm -rf %s" dir; if !link then begin let cwd = Unix.opendir (Sys.getcwd ()) in begin try while true do let f = Unix.readdir cwd in if (Unix.lstat f).Unix.st_kind = Unix.S_LNK then if prefix dir (Unix.readlink f) then cmd "rm -f %s" f done with End_of_file -> () end; Unix.closedir cwd end let () = Arg.parse spec anon usage; check_mlpost_version (); meltpp_plugin_includes := begin match !plugin_includes with | [] -> "" | l -> " " ^ String.concat " " (List.map (fun x -> "-P "^x) l) end; if !clean then do_clean (); if !main_file <> "" then begin let cwd = Sys.getcwd () in make_temp_dir (); Queue.iter handle_auxiliary_file files; handle_main_file !main_file; chdir cwd; if !final && !link then produce_link !main_file end melt-1.4.0/melt/mlpost_off.ml0000644000175000017500000000523411661167412015465 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) module type Signature = sig (** Part of [Melt] which uses [Mlpost]. *) (** The [Melt] library has not been compiled with the [MLPOST] flag on, so this file is empty. If you need this part of the [Melt] library, please install the [Mlpost] library. Then reconfigure, recompile and reinstall [Melt]. View the [README] file for more information. *) val compiled_with_mlpost: bool (** The value of [compiled_with_mlpost] is [false]. *) end let compiled_with_mlpost = false melt-1.4.0/melt/melt.mllib0000644000175000017500000000013211661167412014735 0ustar romainromainPqueue Clist Variable Latex Melt_common Mlpost_specific Melt Plugin_private Meltpp_plugin melt-1.4.0/melt/melt.odocl0000644000175000017500000000002411661167412014736 0ustar romainromainMlpost_specific Meltmelt-1.4.0/melt-mode.el0000644000175000017500000000056111661167412014225 0ustar romainromain(defvar melt-mode-hook nil) (add-to-list 'auto-mode-alist '("\\.mlt\\'" . melt-mode)) (defun melt-mode () "Major mode for editing Melt file" (tuareg-mode) (run-hooks 'melt-mode-hook) ) (add-hook 'melt-mode-hook '(lambda () ; cheap disactivation of literal and comments (defun tuareg-in-literal-or-comment () (cons nil nil)) ))melt-1.4.0/print_version.ml0000644000175000017500000000005211661167412015246 0ustar romainromain#use "melt_version.ml" let () = print () melt-1.4.0/totoconf.ml0000644000175000017500000003645011661167412014213 0ustar romainromain(**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Format let interactive = ref false let config_file = ref "Config" let debug = ref false let forced_vars = ref [] let speclist = [ "-c", Arg.Set_string config_file, " Configuration file"; "-i", Arg.Set interactive, " Interactive mode"; "-debug", Arg.Set debug, " Debug mode (verbose)"; ] let anon_fun x = raise (Arg.Bad (x^": unknown option")) let usage_msg = let name = let name = Filename.basename Sys.executable_name in if String.length name >= 5 && String.sub (String.lowercase name) 0 5 = "ocaml" then "configure.ml" else name in sprintf "Usage: ocaml %s [options]" name (**************************************************************************) (* Errors and Warnings *) (**************************************************************************) let echo x = ksprintf (fun s -> printf "%s\n" s) x let debug x = ksprintf (fun s -> if !debug then printf "Debug: %s\n%!" s) x let error x = ksprintf (fun s -> printf "%!"; eprintf "Error: %s\n%!" s; exit 1) x let warnings = ref [] let warning x = ksprintf (fun s -> warnings := s :: !warnings) x let success () = printf "%!"; eprintf "%!"; List.iter (eprintf "Warning: %s\n%!") (List.rev !warnings); printf "Configuration successful"; match List.length !warnings with | 0 -> printf ".\n%!" | 1 -> printf " (1 warning).\n%!" | c -> printf " (%d warnings).\n%!" c (**************************************************************************) (* *) (**************************************************************************) exception Exec_error of int let try_finally f g = let result = try f (); with exn -> g (); raise exn in (g (): unit); result let exec_line cmd args = let c = String.concat " " (cmd::args) in let tmp = Filename.temp_file "configure_exec_line" ".out" in try_finally (fun () -> try match Sys.command (c ^ " > " ^ tmp) with | 0 -> input_line (open_in tmp) | n -> raise (Exec_error n) with End_of_file -> "") (fun () -> Sys.remove tmp) let which file = try exec_line "which" [file] with Exec_error _ -> raise Not_found let guess_bins files () = let files = List.fold_left begin fun acc file -> try which file :: acc with Not_found -> debug "Not found in PATH: %s" file; acc end [] files in List.rev files (**************************************************************************) (* String Utils *) (**************************************************************************) module Str = struct let last_word s = try let i = String.rindex s ' ' in String.sub s (i+1) (String.length s - i - 1) with Not_found -> s let replace_char f c b = let f = String.copy f in for i = 0 to String.length f - 1 do if f.[i] = c then f.[i] <- b done; f end (**************************************************************************) (* Version Parsing *) (**************************************************************************) module Version = struct type t = int list * string exception Uncomparable_versions of t * t let parse s = let rec first_not_digit p = if p < String.length s then match s.[p] with | '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' | '.' -> first_not_digit (p + 1) | _ -> p else raise Not_found in let num_part, suffix_part = try let i = first_not_digit 0 in String.sub s 0 i, String.sub s i (String.length s - i) with Not_found -> s, "" in let rec split s p = try let i = String.index_from s p '.' in String.sub s p (i-p) :: (split s (i+1)) with Not_found -> if s = "" then [] else [String.sub s p (String.length s - p)] in List.map int_of_string (split num_part 0), suffix_part let rec compare_vnums a b = match a, b with | [], [] -> 0 | [], _ -> -1 | _, [] -> 1 | x1::r1, x2::r2 -> match x1 - x2 with | 0 -> compare_vnums r1 r2 | c -> c let prefix s1 s2 = let l1 = String.length s1 in String.length s2 >= l1 && String.sub s2 0 l1 = s1 let compare (v1, s1) (v2, s2) = match compare_vnums v1 v2 with | 0 -> begin match prefix s1 s2, prefix s2 s1 with | true, true -> 0 | true, false -> -1 | false, true -> 1 | false, false -> raise (Uncomparable_versions(([], s1), ([], s2))) end | c -> c let compare a b = compare (parse a) (parse b) let eq a b = compare a b = 0 let ne a b = compare a b <> 0 let le a b = compare a b <= 0 let lt a b = compare a b < 0 let ge a b = compare a b >= 0 let gt a b = compare a b > 0 end (**************************************************************************) (* Previous Configuration *) (**************************************************************************) let parse_config file = let trim s = let is_blank = function | ' ' | '\t' | '\n' | '\r' -> true | _ -> false in let len = String.length s in let rec left n = if n < len && is_blank s.[n] then left (n+1) else n in let rec right n = if n >= 0 && is_blank s.[n] then right (n-1) else n in let left = left 0 and right = right (len-1) in if left < right then String.sub s left (right-left+1) else "" in let parse_config_line acc line = try let i = String.index line '=' in let left = String.sub line 0 i in let right = String.sub line (i + 1) (String.length line - i - 1) in (String.uppercase (trim left), trim right) :: acc with Not_found -> acc in let f = open_in file in let lines = ref [] in try while true do lines := input_line f :: !lines done; assert false with End_of_file -> close_in f; List.fold_left parse_config_line [] !lines let config = ref [] let old_var x = try Some (List.assoc (String.uppercase x) !config) with Not_found -> None (**************************************************************************) (* Variables *) (**************************************************************************) type internal_var = { iv_name: string; iv_print: Format.formatter -> unit -> unit; iv_query: string option; } type 'a var = { name: string; value: 'a; } let (!!) x = x.value let vars = ref [] let var_exists name = let name = String.uppercase name in List.exists (fun v -> String.uppercase v.iv_name = name) !vars module type STRINGABLE = sig type t val to_string: t -> string val of_string: string -> t option end module type VAR = sig type data val make: ?query: string -> ?check: (data -> bool) -> ?guess: (unit -> data list) -> ?fail: (unit -> data) -> string -> data var val umake: ?query: string -> ?check: (data -> bool) -> ?guess: (unit -> data list) -> ?fail: (unit -> data) -> string -> unit val simple: string -> data -> data var val usimple: string -> data -> unit val get: data var -> data val print: Format.formatter -> data var -> unit end module Var(T: STRINGABLE) = struct type data = T.t let check _ = true let guess () = [] let print fmt x = fprintf fmt "%s = %s\n" x.name (T.to_string x.value) let rec find_guess check = function | [] -> None | x::rem -> debug "Guess: %s" (T.to_string x); if check x then Some x else find_guess check rem let make ?query ?(check = check) ?(guess = guess) ?fail name = if var_exists name then warning "Variable %s has already been defined." name; let check_option = function | None -> false | Some x -> check x in (* Query the user until he gives a valid value or the default value. *) let do_query query def = let def_str = match def with | None -> "" | Some x -> sprintf " [%s]" (T.to_string x) in let rec ask () = printf "%s%s: %!" query def_str; let l = read_line () in if l = "" then def else let value = T.of_string l in if check_option value then value else begin printf "Invalid value: %s.\n%!" l; ask () end in ask () in (* Forced value? *) let value = try let value = List.assoc name !forced_vars in let v = T.of_string value in match v with | None -> error "Invalid value for %s: %s." name value | Some v -> if check v then begin begin match query with | Some query -> printf "%s: %s\n" query (T.to_string v) | None -> () end; v end else error "Invalid value for %s: %s." name value with Not_found -> begin (* Old value. *) let value = match old_var name with | None -> None | Some x -> debug "%s: Found old value = %s" name x; T.of_string x in (* Check or guess. *) let value = if check_option value then value else begin debug "Guessing for %s" name; find_guess check (guess ()) end in (* User interaction. *) let value = match query with | Some query when !interactive -> do_query query value | _ -> value in (* Final check. *) let value = match value, fail, query with | None, None, None -> error "%s: Not found" name | None, None, Some query -> error "%s: Not found" query | None, Some fail, _ -> fail () | Some value, _, _ -> value in (* Notify the user. *) begin match query with | Some query when not !interactive -> printf "%s: %s\n" query (T.to_string value) | _ -> () end; value end in let var = { name = name; value = value; } in (* Register the variable. *) let internal = { iv_name = name; iv_print = (fun fmt () -> print fmt var); iv_query = query; } in vars := internal :: !vars; var let umake ?query ?check ?guess ?fail name = ignore (make ?query ?check ?guess ?fail name) let simple name value = make ~check: (fun _ -> false) ~fail: (fun () -> value) name let usimple name value = ignore (simple name value) let get x = x.value end module SVar = Var(struct type t = string let of_string x = Some x let to_string x = x end) module BVar = Var(struct type t = bool let of_string x = Some (String.uppercase x = "YES") let to_string = function | true -> "YES" | false -> "NO" end) module IVar = Var(struct type t = int let of_string x = try Some (int_of_string x) with Failure "int_of_string" -> None let to_string = string_of_int end) module FVar = Var(struct type t = float let of_string x = try Some (float_of_string x) with Failure "float_of_string" -> None let to_string = string_of_float end) (**************************************************************************) (* Init and Finish *) (**************************************************************************) let force ?option var doc = let option = match option with | None -> "-"^var | Some option -> option in let spec = Arg.String (fun value -> forced_vars := (var, value) :: !forced_vars) in option, spec, doc let init ?(file = "Config") ?(spec = []) () = config_file := file; Arg.parse (Arg.align (spec @ speclist)) anon_fun usage_msg; config := (try parse_config !config_file with _ -> []) let finish () = let out = try open_out !config_file with Sys_error s -> error "Cannot write to file: %s" !config_file in let fmt = formatter_of_out_channel out in let sec, prim = List.partition (fun x -> x.iv_query = None) (List.rev !vars) in fprintf fmt "# This file has been automatically generated. # After any modification, you should run the configuration tool again.\n\n"; List.iter begin fun var -> let desc = match var.iv_query with | Some x -> x | None -> assert false in fprintf fmt "# %s\n%a\n" desc var.iv_print () end prim; if sec <> [] then fprintf fmt "# The following variables are not supposed to be edited by hand.\n"; List.iter (fun var -> fprintf fmt "%a" var.iv_print ()) sec; fprintf fmt "%!"; close_out out; success () melt-1.4.0/configure0000755000175000017500000000010711661167412013723 0ustar romainromain#!/bin/sh echo "Please read the README file." ocaml configure.ml -i $*melt-1.4.0/CHANGES0000644000175000017500000001344411661167412013017 0ustar romainromainChanges that may break existing programs are marked using a star *. Version 1.3.0 ============= The documentation has been updated and extended. Known bugs: * mlpost figures assume .1 filename extension when compiling with -ps. It works fine with mlpost up to 0.8.1, but not with the development version of mlpost which produce .mps files. * bench/slides.mlt does not compile using mlpost 8.1 (it does with the development version) because the type of Box.pic changed. This should not bother you as this is just an example. To sum up, choose your version of mlpost well. Preprocessor: * Percent character (%) now yields \% in .tex files, instead of just % which would be a LaTeX comment. Lines being different in .mlt and .tex files, this made no sense. * Comments may be used in text and math mode. They use (* *) and may be nested. - Bugfix: \n in verbatim mode is now handle correctly. * \\ now yields a single \ in the .ml file Melt tool and library: - Programs which are compiled and linked with the Melt library now accept the -depends option on the command line. It produces, along with the X.tex file, a X.tex.depends file containing a hash of all Mlpost figures. If you have your own Makefile, you may add a dependency between the .ps or .pdf to this .tex.depends file to ensure the final document is recompiled if a figure changes. - -classic-display is not passed to recent mlpost versions which do not handle it * function "latex" has been renamed to "picture_of_latex", the "latex" value is now the \LaTeX command which prints the LaTeX logo - Added -latex option to specify the latex command * .ml files are only copied into _melt, they are no longer compiled nor executed. .mlt files are copied and preprocessed. They are not compiled nor executed either. If you need your auxiliary files to be compiled and preprocessed, just add them as dependencies of your main file (using "open" for instance, or adding a module initializer and calling it from your main file). They will then be compiled and linked by Ocamlbuild. Latex library: - implementation uses lists with fast concatenation, which should in particular help to prevent stack overflows - packages used by commands in ~title, ~author, ~date and ~prelude of the document function are now taken into account - figure caption may be placed at the side (?side_caption) - figures may be wide (?wide) - wrapfigure, floatingfigure, subfloat - beamer colors may be given using rgb values - ~underscore argument for pseudocode verbatim function - equation - index_exponent - variables (similar in use to LaTeX counters, but evaluated when pretty-printing the .tex file) - empty, is_empty - more delimiters, just_left, just_right, between - index functionalities - support of multicolumn via the 'layout' optional argument of 'array_line' - Beamer columns - and (many) various other latex commands Other: * module Version renamed to Melt_version - man pages have been written, they are installed with "make install" - fixed META file dependencies Version 1.2.0 ============= Configuration, Compilation and Installation - Default installation directory is now OCAMLLIB/melt, where OCAMLLIB is either: the default installation directory of ocamlfind, or the standard directory of caml if ocamlfind is not available. - (bugfix) Do not link with mlpost if MLPOST = NO. Melt tool and library: - Add -latex file.tex option to Mlpost to compute prelude, if the tex file already exists. - Cairo support for Mlpost 0.7 * ?pdf argument for mlpost becomes ?mode - -mlpost option - -mlpost-no-prelude option Preprocessor: - Print opened and pending modes in unexpected end of file errors - Print an error if a "}" appears in text or math mode Latex library: - (bugfix) the ~center option of figure has been fixed - phantom, vphantom, hphantom - Beamer overlays - makebox, framebox - unusual_command, for weird LaTeX commands with interleaved [] and {} arguments or for commands with multiple optional arguments - place_label to hackishly place a label - latex_of_size for user-defined commands * Latex.document does not add an empty \author{} if the ~author is not given Version 1.1.0 ============= Configuration: - Replaced the configuration tool by a more powerful one using Totoconf Melt tool: - -classic-display option - Added the latop tool to parse LaTeX output and re-print it prettier and with less trash (for now it is more or less deactivated though) Preprocessor: - \" in comments become " to stop the OCaml compiler from complaining about a string litteral not terminated in a comment. - $, " and { didn't work as verbatim delimiters and now a parse error is printed - Errors are now printed as "Melt parse error" instead of just "Parse error" - Underscores (_) are now accepted in verbatim function names Latex and Melt libraries: - Latex.Verbatim.pseudocode (and Melt.Verbatim.pseudocode) * Bugfix: ~packages argument of commands and environment are now taken into account even if the command is used deep inside the AST * Bugfix: Melt.convert now forces math or text mode for `M and `T - Latex.size type enhanced with more sizes - Reorganized the interface and its documentation Latex and Melt libraries (smaller features): * inferrule_ replaced by inferrule, which has many new options - parbox, minipage, center - hspace - bot - textrm, textsf, mathcal - newline_size - Verbatim.trim, trim_end and trim_begin - Verbatim.split_lines - listoffigures, listoftables - many more font size commands - llbracket, rrbracket (package stmaryrd) - box_ Version 1.0.1 ============= - Melt compiles with Ocamlbuild 3.10.0 even with the main Makefile. - All combinations of -no-mlpost or -no-ocamlbuild options should work. You still have to add "-I +mlpost" yourself if you compiled Melt with Mlpost but use the -no-mlpost option. - The -no-mlpost option is set by default if Melt was compiled without Mlpost. melt-1.4.0/.boring0000644000175000017500000000161111661167412013276 0ustar romainromain# Boring file regexps: \.hi$ \.hi-boot$ \.o-boot$ \.o$ \.o\.cmd$ # *.ko files aren't boring by default because they might # be Korean translations rather than kernel modules. # \.ko$ \.ko\.cmd$ \.mod\.c$ (^|/)\.tmp_versions($|/) (^|/)CVS($|/) \.cvsignore$ ^\.# (^|/)RCS($|/) ,v$ (^|/)\.svn($|/) (^|/)\.hg($|/) \.bzr$ (^|/)SCCS($|/) ~$ (^|/)_darcs($|/) \.bak$ \.BAK$ \.orig$ \.rej$ (^|/)vssver\.scc$ \.swp$ (^|/)MT($|/) (^|/)\{arch\}($|/) (^|/).arch-ids($|/) (^|/), \.prof$ (^|/)\.DS_Store$ (^|/)BitKeeper($|/) (^|/)ChangeSet($|/) \.py[co]$ \.elc$ \.class$ \# (^|/)Thumbs\.db$ (^|/)autom4te\.cache($|/) (^|/)config\.(log|status)$ ^\.depend$ (^|/)(tags|TAGS)$ #(^|/)\.[^/] (^|/|\.)core$ \.(obj|a|exe|so|lo|la)$ ^\.darcs-temp-mail$ -darcs-backup[[:digit:]]+$ \.(fas|fasl|sparcf|x86f)$ \.part$ (^|/)\.waf-[[:digit:].]+-[[:digit:]]+($|/) (^|/)\.lock-wscript$ ^\.darcs-temp-mail$ _build _melt bench.log$ Config melt-1.4.0/Makefile0000644000175000017500000001041011661167412013452 0ustar romainromain########################################################################## # Copyright (c) 2009, Romain BARDOU # # All rights reserved. # # # # Redistribution and use in source and binary forms, with or without # # modification, are permitted provided that the following conditions are # # met: # # # # * Redistributions of source code must retain the above copyright # # notice, this list of conditions and the following disclaimer. # # * Redistributions in binary form must reproduce the above copyright # # notice, this list of conditions and the following disclaimer in the # # documentation and/or other materials provided with the distribution. # # * Neither the name of Melt nor the names of its contributors may be # # used to endorse or promote products derived from this software # # without specific prior written permission. # # # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS # # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR # # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT # # OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, # # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, # # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY # # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE # # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # ########################################################################## include Config BUILD := _build OB := $(OCAMLBUILD) $(OCAMLBUILDFLAGS) -no-links -build-dir $(BUILD) -Is prelude,latex,meltpp,melt OBCLASSIC := $(OB) -classic-display ifeq ($(TERM), dumb) OB := $(OBCLASSIC) endif HAS_OCAMLOPT := $(shell if which ocamlopt > /dev/null; then echo yes; else echo no; fi) NATDYNLINK := $(shell if [ -f `ocamlc -where`/dynlink.cmxa ]; then echo YES; else echo NO; fi) ################################################################################# BYTE = latex/latex.cma melt/melt.cma melt/tool.byte latop/latop.byte meltpp/main.byte ifeq ($(HAS_OCAMLOPT),yes) NATIVE := latex/latex.cmxa melt/melt.cmxa melt/tool.native latop/latop.native ifeq ($(NATDYNLINK), YES) NATIVE := $(NATIVE) meltpp/main.native endif else NATIVE := endif DOC = latex/latex.docdir/index.html melt/melt.docdir/index.html BENCHPLUGS = bench/plugs/quot.cma default: check-ocamlbuild world check-ocamlbuild: @if (test $(OCAMLBUILD) = NO); then echo "This makefile cannot be used without Ocamlbuild.\nPlease read the README file."; exit 1; fi fast: $(OB) $(BYTE) doc: $(OB) $(DOC) world all: $(OB) $(BYTE) $(DOC) $(NATIVE) ################################################################################# noob.makefile: clean cat noob.prelude > $@ $(OBCLASSIC) $(BYTE) $(NATIVE) $(DOC) | ob2make -r melt/mlpost_off.ml MLPOSTSPECIFIC -r melt/mlpost_on.ml MLPOSTSPECIFIC -Ivar OCAMLINCLUDES all >> $@ install: $(OCAML) install.ml -mlpost $(MLPOST) -bin $(INSTALLBIN) -lib $(INSTALLLIB) -man $(INSTALLMAN) -build $(BUILD) uninstall: $(OCAML) install.ml -mlpost $(MLPOST) -bin $(INSTALLBIN) -lib $(INSTALLLIB) -man $(INSTALLMAN) -uninstall clean: rm -rf $(BUILD) bench/_melt rm -f *~ rm -f bench/*.bench.log dist-clean: clean rm -f Config check bench test %.bench %.check %.test: $(OB) $(BYTE) $(NATIVE) $(BENCHPLUGS) @make -C bench $@ dist: noob.makefile NAME=melt-`ocaml print_version.ml`; \ mkdir $$NAME; \ cp --parents $(shell darcs query manifest) $^ $$NAME; \ tar czf $$NAME.tgz $$NAME; \ rm -rf $$NAME .PHONY: default fast world clean doc all world.10 bench test check dist check-ocamlbuild Config: configure.ml totoconf.ml ocaml configure.ml melt-1.4.0/myocamlbuild.ml0000644000175000017500000000423111661167412015031 0ustar romainromainopen Ocamlbuild_plugin open Command let parse_config file = let trim s = let is_blank = function | ' ' | '\t' | '\n' | '\r' -> true | _ -> false in let len = String.length s in let rec left n = if n < len && is_blank s.[n] then left (n+1) else n in let rec right n = if n >= 0 && is_blank s.[n] then right (n-1) else n in let left = left 0 and right = right (len-1) in if left < right then String.sub s left (right-left+1) else "" in let parse_config_line acc line = let line = trim line in if line = "" || line.[0] = '#' then acc else try let i = String.index line '=' in let left = String.sub line 0 i in let right = String.sub line (i + 1) (String.length line - i - 1) in (String.uppercase (trim left), trim right) :: acc with Not_found -> acc in let f = open_in file in let lines = ref [] in try while true do lines := input_line f :: !lines done; assert false with End_of_file -> List.fold_left parse_config_line [] !lines let config = let config = try parse_config "Config" with _ -> [] in fun value -> try List.assoc (String.uppercase value) config with Not_found -> "" let config_yes x = String.uppercase (config x) = "YES" let tool_targets = [ "melt/tool.native"; "melt/tool.byte" ; "meltpp/main.native"; "meltpp/main.byte"] let () = dispatch begin function | After_rules -> flag ["ocaml"; "doc"] (S[A "-hide-warnings"; Sh (config "OCAMLINCLUDES")]); ocaml_lib ~extern: true "cairo"; ocaml_lib ~extern: true "bitstring"; ocaml_lib ~extern: true "mlpost"; if config_yes "MLPOST" then List.iter (fun x -> tag_file x [ "use_mlpost" ]) tool_targets; if config_yes "MLPOST" && config_yes "MLPOSTCAIRO" then List.iter (fun x -> tag_file x [ "use_bigarray"; "use_bitstring"; "use_cairo" ]) tool_targets; let mlpost_onoff = config "MLPOSTSPECIFIC" in let mlpost_specific = "melt/mlpost_specific.ml" in rule mlpost_specific ~dep: mlpost_onoff ~prod: mlpost_specific (fun _ _ -> cp mlpost_onoff mlpost_specific) | _ -> () end melt-1.4.0/configure.ml0000644000175000017500000001575011661167412014341 0ustar romainromain (**************************************************************************) (* Copyright (c) 2009, Romain BARDOU *) (* All rights reserved. *) (* *) (* Redistribution and use in source and binary forms, with or without *) (* modification, are permitted provided that the following conditions are *) (* met: *) (* *) (* * Redistributions of source code must retain the above copyright *) (* notice, this list of conditions and the following disclaimer. *) (* * Redistributions in binary form must reproduce the above copyright *) (* notice, this list of conditions and the following disclaimer in the *) (* documentation and/or other materials provided with the distribution. *) (* * Neither the name of Melt nor the names of its contributors may be *) (* used to endorse or promote products derived from this software *) (* without specific prior written permission. *) (* *) (* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *) (* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *) (* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR *) (* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT *) (* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) (* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) (* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, *) (* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY *) (* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT *) (* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE *) (* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) (**************************************************************************) open Format #use "totoconf.ml" let () = init ~file: "Config" ~spec: [ force "OCAMLC" " OCaml bytecode compiler"; force "MLPOST" " Mlpost library directory"; force "INSTALLBIN" " Install directory (tool binaries)"; force "INSTALLLIB" " Install directory (OCaml libraries)"; force "INSTALLMAN" " Install directory (man pages)"; ] (); let ocamlc = SVar.make ~query: "OCaml bytecode compiler" ~guess: (guess_bins ["ocamlc.opt"; "ocamlc"]) "OCAMLC" in let ocaml_dir = Filename.dirname !!ocamlc in let ocaml_version = exec_line !!ocamlc ["-version"] in echo "OCaml version: %s" ocaml_version; let ocaml_where = exec_line !!ocamlc ["-where"] in let ocaml_var name = SVar.umake ~guess: (guess_bins [ Filename.concat ocaml_dir (name ^ ".opt"); Filename.concat ocaml_dir name; name ^ ".opt"; name ]) ~check: (fun s -> let v = Str.last_word (exec_line s ["-version"]) in if name <> "ocamlbuild" || Version.ge ocaml_version "3.11" then if not (Version.eq ocaml_version v) then warning "Version of %s (%s) do not match \ compiler version (%s)" s v ocaml_version; true) (String.uppercase name) in if (try Sys.getenv "HAS_OCAMLOPT" with Not_found -> "no") = "yes" then ocaml_var "ocamlopt"; ocaml_var "ocamlbuild"; ocaml_var "ocaml"; ocaml_var "ocamllex"; ocaml_var "ocamlyacc"; ocaml_var "ocamldoc"; let cm_dir pkg cm = SVar.make ~guess: (fun s -> let l = [ Filename.concat ocaml_where pkg; ocaml_where; Filename.concat ocaml_dir pkg; ocaml_dir; ] in try exec_line "ocamlfind" ["query"; pkg; "2> /dev/null"] :: l with Exec_error _ -> l) ~check: (fun s -> Sys.file_exists (Filename.concat s cm)) in let mlpost_cm_dir = cm_dir "mlpost" "mlpost.cma" ~query: "Mlpost library directory" ~fail: (fun () -> warning "Mlpost not found"; "") "MLPOSTLIBDIR" in let check_mlpost_version () = try let v = exec_line (which "mlpost") ["-version"; "2> /dev/null"] in if Version.ge v "0.6" || v = "current" then begin echo "Mlpost version: %s" v; true end else begin echo "Mlpost version too old (%s)" v; false end with | Not_found -> warning "Mlpost tool not found."; false | Exec_error 2 -> warning "Mlpost version too old (<0.6)."; false in let mlpost = !!mlpost_cm_dir <> "" && check_mlpost_version () in BVar.usimple "MLPOST" mlpost; SVar.usimple "MLPOSTSPECIFIC" (if mlpost then "melt/mlpost_on.ml" else "melt/mlpost_off.ml"); let mlpost_with_cairo = mlpost && try ignore (exec_line "mlpost" ["-cairo"]); true with Exec_error _ -> false in BVar.usimple "MLPOSTCAIRO" mlpost_with_cairo; let cm_dir_if_mlpost_with_cairo pkg cm name var = if mlpost_with_cairo then cm_dir pkg cm ~query: (name^" library directory") ~fail: (fun () -> warning "%s not found" name; "") var else cm_dir pkg cm ~fail: (fun () -> "") var in let bitstring_cm_dir = cm_dir_if_mlpost_with_cairo "bitstring" "bitstring.cma" "Bitstring" "BITSTRINGLIBDIR" in let cairo_cm_dir = cm_dir_if_mlpost_with_cairo "cairo" "cairo.cma" "Cairo" "CAIROLIBDIR" in SVar.umake ~query: "Install directory (tool binaries)" ~guess: (fun () -> ["/usr/local/bin"]) "INSTALLBIN"; SVar.umake ~query: "Install directory (OCaml libraries)" ~guess: (fun () -> let l = [Filename.concat ocaml_where "melt"] in try let dir = exec_line "ocamlfind" ["printconf"; "destdir"; "2> /dev/null"] in (Filename.concat dir "melt"):: l with Exec_error _ -> l ) "INSTALLLIB"; SVar.umake ~query: "Install directory (man pages)" ~guess: (fun () -> ["/usr/local/share/man/man1"]) "INSTALLMAN"; let ocaml_includes l = let l = List.filter (fun s -> s <> "" && s <> ocaml_where) l in let l = List.map (sprintf "-I %s") l in String.concat " " l in let ocaml_includes = let includes = if mlpost then [ !!mlpost_cm_dir; !!bitstring_cm_dir; !!cairo_cm_dir ] else [] in SVar.simple "OCAMLINCLUDES" (ocaml_includes includes) in let ocamlbuild_flags l = let l = String.concat " " l in let l = Str.replace_char l ' ' ',' in if l <> "" then sprintf "-cflags %s -lflags %s" l l else "" in SVar.usimple "OCAMLBUILDFLAGS" (ocamlbuild_flags [!!ocaml_includes]); finish () melt-1.4.0/man/0000755000175000017500000000000011661167412012571 5ustar romainromainmelt-1.4.0/man/latop.10000644000175000017500000000117611661167412013777 0ustar romainromain.\" Hey, EMACS: -*- nroff -*- .TH LATOP 1 "September 2010" .\" Please adjust this date whenever revising the manpage. .SH NAME latop \- Filter the output messages of LaTeX .SH SYNOPSIS .B latop .SH DESCRIPTION .PP \fBlatop\fP filters the output messages of LaTeX. It ignores unimportant messages and only keeps warning and errors, printed in a standardised way. Right now, latop is only a work in progress, and should only be used by Melt. .SH AUTHOR Latop was written by Romain Bardou as part of the Melt distribution. .PP This manual page was written by Romain Bardou (but may be used by others). melt-1.4.0/man/meltpp.10000644000175000017500000000240211661167412014152 0ustar romainromain.\" Hey, EMACS: -*- nroff -*- .TH MELTPP 1 "September 2010" .\" Please adjust this date whenever revising the manpage. .SH NAME meltpp \- The Melt pre-processor .SH SYNOPSIS .B meltpp .RI [OPTIONS] " " [PLUGINS] " files" .SH DESCRIPTION .PP \fBmeltpp\fP is a pre-processor which takes Melt source codes (.mlt) and convert them to OCaml source codes (.ml). It is modular as it accepts user PLUGINS as arguments. .SH OPTIONS .TP .B \-P Specify the location of plugins. .TP .B \-o Specify the name of the output file. Cannot be used when compiling multiple files at the same time. .TP .B \-open Add "open Module;;" at the beginning of the file. .TP .B \-dir Add path to file locations when printing error messages. Useful to trick your IDE when compiling in a temporary directory. .TP .B \-version Print the version number of Melt. .TP .B \-\- Pass the remaining arguments to the generated program. .TP .B \-help, \-\-help Display the list of options .SH SEE ALSO .BR melt (1), .BR ocamlc (1). .br .SH AUTHOR Melt was written by Romain Bardou. Contributors include Vincent Aravantinos, Francois Bobot, Pierre Chambart and Arnaud Spiwack. .PP This manual page was written by Romain Bardou (but may be used by others). melt-1.4.0/man/meltbuild.10000644000175000017500000001205311661167412014635 0ustar romainromain.\" Hey, EMACS: -*- nroff -*- .TH MELTBUILD 1 "September 2010" .\" Please adjust this date whenever revising the manpage. .SH NAME melt \- compiles Melt sources into DVI, PostScript or PDF files .SH SYNOPSIS .B meltbuild .RI [OPTIONS] " " [OTHER_FILES] " MAIN_FILE" .SH DESCRIPTION .PP \fBmeltbuild\fP compiles Melt sources (.mlt files) into DVI, PostScript (.ps) or PDF files. It first calls the Melt preprocessor .BR meltpp. It then calls the OCaml compiler, either directly or through Ocamlbuild or Mlpost. The program is linked with the Melt and Latex libraries. The program is then executed, producing .tex files. Then .BR latex or .BR pdflatex is called to produce the document. The MAIN_FILE is the main file of your document. It is the one which will be compiled, executed, and whose produced .tex file will be compiled. OTHER_FILES will be copied into the _melt directory. They are additional files needed to compile your document, such as modules, class styles or included figures. If one OTHER_FILE has extension .mlt, it will also be pre-processed. Typically, a .mlt file has two usages. The first one is to define values usable by the main .mlt file. The second one is to call the emit function to produce .tex files that can be included in your main .tex file. This is especially useful if your main .tex file is not written in Melt. Note that if you want an OTHER_FILE to be compiled and executed, you have to use it in the MAIN_FILE so that Ocamlbuild links it. If you do not use Ocamlbuild, multi-modules documents are not supported. .SH OPTIONS .TP .B \-meltpp Specify the location and name of the Melt pre-processor binary. .TP .B \-latop Specify the location and name of the Latop binary. .TP .B \-mlpost Specify the location and name of the Mlpost wrapper binary. .TP .B \-mlpost-no-prelude Do not pass a \-latex option to the Mlpost wrapper. By default, the .tex file produced by your Melt document is given to Mlpost so it can compute a prelude to be used when compiling images. This option disables this behavior. The prelude is the contents of the .tex file before the document environment begins. .TP .B \-latex Specify the latex command to use. .TP .B \-P Specify the location of pre-processor plugins. This option is passed to the Melt pre-processor. .TP .B \-I Look for additional OCaml libraries in the given directory. This option is passed to the OCaml compiler. .TP .B \-L Add a link to the path in the _melt directory. Useful if you don't want to copy the contents of the directory. .TP .B \-classic-display Give the \-classic\-display option to Ocamlbuild. Useful if your terminal does not handle the Ocamlbuild animation or if you want to keep a trace of the sequence of commands which are called. Has no effect if it is Mlpost that calls Ocamlbuild. .TP .B \-no-mlpost Do not use the Mlpost wrapper, call Ocamlbuild directly instead (or the OCaml compiler if \-no\-ocamlbuild is given too). Unspecified if your document produces Mlpost images. .TP .B \-no-ocamlbuild Do not use Ocamlbuild to compile your program. The OCaml compiler will be called directly. Usually only makes sense if your source code is made of only one file, and if you are using an OCaml version older than 3.10.2. .TP .B \-no-final Do not produce the final document, i.e. do not call latex. The MAIN_FILE will still be compiled and executed. .TP .B \-no-link By default, a symbolic link to the produced DVI, PS or PDF document is created in the current directory. This option disables this behavior. .TP .B \-native Compile the program to native code bytecode instead of bytecode. .TP .B \-dvi Produce a DVI instead of a PS file. .TP .B \-ps Produce a PS file. This is the default behavior. .TP .B \-pdf Produce a PDF instead of a PS file. .TP .B \-ps2pdf Produce a PS file, then convert it to PDF using ps2pdf. Useful if pdflatex won't compile your document. .TP .B \-cairo Use the Cairo backend of Mlpost, instead of Metapost. Implies \-pdf. .TP .B \-mps Use the native MPS backend of Mlpost, instead of Metapost. Implies \-pdf. .TP .B \-quiet, \-q Be quiet. Less messages will be printed on the terminal, if any. .TP .B \-continue Continue on errors. .TP .B \-fake, \-n Do not actually execute commands. Useful if you want to know what the Melt tool would execute to compile your document. .TP .B \-melt-dir Change the name used for the _melt directory. .TP .B \-clean Remove the _melt directory and, if not \-no\-link, all symbolic links of the current directory linking into _melt. Cleaning is done before anything else. .TP .B \-version Print the version number of Melt. .TP .B \-\- Pass the remaining arguments to the generated program. .TP .B \-help, \-\-help Display the list of options .SH SEE ALSO .BR meltpp (1), .BR latop (1), .BR mlpost (1), .BR ocamlc (1), .BR ocamlbuild (1), .BR latex (1), .BR pdflatex (1). .br .SH AUTHOR Melt was written by Romain Bardou. Contributors include Vincent Aravantinos, Francois Bobot, Pierre Chambart and Arnaud Spiwack. .PP This manual page was written by Romain Bardou (but may be used by others). melt-1.4.0/noob.prelude0000644000175000017500000000453711661167412014346 0ustar romainromain########################################################################## # Copyright (c) 2009, Romain BARDOU # # All rights reserved. # # # # Redistribution and use in source and binary forms, with or without # # modification, are permitted provided that the following conditions are # # met: # # # # * Redistributions of source code must retain the above copyright # # notice, this list of conditions and the following disclaimer. # # * Redistributions in binary form must reproduce the above copyright # # notice, this list of conditions and the following disclaimer in the # # documentation and/or other materials provided with the distribution. # # * Neither the name of Melt nor the names of its contributors may be # # used to endorse or promote products derived from this software # # without specific prior written permission. # # # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS # # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR # # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT # # OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, # # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT # # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, # # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY # # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE # # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # ########################################################################## include Config default: all Config: configure.ml ocaml configure.ml install: $(OCAML) install.ml -bin $(INSTALLBIN) -lib $(INSTALLLIB) uninstall: $(OCAML) install.ml -bin $(INSTALLBIN) -lib $(INSTALLLIB) -uninstall melt-1.4.0/LICENSE0000644000175000017500000000303611661167412013025 0ustar romainromainCopyright (c) 2009, Romain BARDOU All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Melt nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.