1:- module(tex, [
    2	texparse/2,
    3	tex_tokens/2,
    4	tex_env/2,
    5	filler/2]).    6
    7:- encoding(utf8).
    8
    9term_expansion --> pac:expand_pac.
   10
   11:- use_module(pac(op)).   12
   13		/*************
   14		*     TeX    *
   15		*************/
   16
   17% ?- texparse(`$a$`, X).
   18% ?- tex:texparse(`Let $x$ be $\sqrt{a^2+b^2}.$`, X), maplist(writeln, X).
   19
   20texparse --> tex_tokens, !, tex_env.
   21%
   22tex_tokens(X, Y) :- tex_tokens(Y, X, []).
   23%
   24tex_env(X, Y) :- tex_env(Y, [], X, []), !.
   25%
   26tex_tokens([]) --> "".
   27tex_tokens(X)  --> "\\\n", !, tex_tokens(X).
   28tex_tokens(X)  --> tex_token(X,Y), !, tex_tokens(Y).
   29%
   30tex_token(X, Y)  --> tex_cs(X, Y).
   31tex_token(X, Y)  --> tex_group(X, Y).
   32tex_token(X, Y)  --> tex_math(X, Y).
   33tex_token(X, Y)  --> tex_comment(X, Y).
   34tex_token([C|X], X) --> [C].
   35
   36%
   37tex_cs([cs(Name)|X], X) --> "\\",
   38	wl("[a-zA-Z]+", Name1),
   39	{compound(Name1)},
   40	{atom_codes(Name, Name1)}.
   41tex_cs([cs(C)|X], X)    --> "\\" , [C1], {atom_codes(C, [C1])}.
   42%
   43tex_group([group(X)|Y], Y) --> "{", tex_tokens(X), "}".
   44
   45%
   46tex_math([ddol(X)|Y],Y) --> "$$", tex_tokens(X), "$$".
   47tex_math([dol(X)|Y],Y)  --> "$", tex_tokens(X), "$".
   48
   49%%%%% TeX environments
   50tex_env(X, X) --> "".
   51tex_env([group(X)|Y], Z) --> [group(G)],
   52      {tex_env(G,X)},
   53      tex_env(Y,Z).
   54tex_env([env(Name,X)|Y], Z) --> [cs(begin)],
   55       filler,
   56       [group(T)],
   57		tex_env(X, []),
   58		[cs(end)],
   59		filler,
   60		[group(T)],
   61		{atom_codes(Name, T)},
   62		tex_env(Y,Z).
   63tex_env([ddol(X)|Y], Z)	   --> [ddol(M)],
   64	    {tex_env(M, X)},
   65	    tex_env(Y, Z).
   66tex_env([dol(X)|Y], Z)	   --> [dol(M)],
   67	    {tex_env(M, X)},
   68	     tex_env(Y, Z).
   69tex_env([X|Y], Z)  --> [X], tex_env(Y, Z).
   70
   71% ?- tex:tex_comment(X, [], `%abc\n`, R).
   72% ?- tex:tex_comment(X, [], `%abc`, R).
   73tex_comment([comment(X)|Y], Y) --> "%", wl("[^\n]*$", X).
   74%
   75filler --> wl("[\s\t]*")