1:- module(dev, []). 2term_expansion --> pac:expand_pac.
3:- use_module(pac(op)). 4
8:- encoding(utf8).
9:- set_prolog_flag(allow_variable_name_as_functor, true). 10
13
14collect_ascii --> sed(wl("[^a-zA-Z\\\n]+") / "---").
15
16
18ec--> edit_hawking_with_comment.
19
20eo--> edit_hawking_without_comment.
21
22ed--> edit_hawking_delete.
23
24ei--> edit_hawking_insert.
25
26es--> edit_hawking_short.
27
28ecs--> edit_hawking_with_comment_short.
29
--> region, peek(A, ["[[[[ ", A, " ====>\n", A, " ]]]]\n{{{{ }}}}\n"]), overwrite.
31
32edit_hawking_short --> region, peek(A, ["[[[[ ", A, " ====> ", A, " ]]]]"]), overwrite.
33
--> region, peek(A, ["[[[[ ", A, " ====> ", A, " ]]]]ã{{{{ }}}}"]), overwrite.
35
--> region, peek(A, ["[[[[ ", A, " ====> ", A, " ]]]]"]), overwrite.
37
38edit_hawking_delete --> region, peek(A, ["[[[[ ", A, " ====> ]]]]"]), overwrite.
39
40edit_hawking_insert --> peek(["[[[[ ====> ]]]]"]), overwrite.
41
42
43nkf(D, S, Options) :- eh:directory(D, nkf(S, Options)).
44
45nkf(S, Options) :- eh:directory_filter(S, Fs0),
46 insert(" ", Fs0, Fs),
47 eh:sh(nkf(Options, Fs)).
48
49suffix(L, Y):- member(X, L), sub_atom(Y,_,_,0,X), !.
50
52
53align --> region, env_align, overwrite.
54
55env_equation(Label) -->
56 peek(A, [ "\\begin{equation}", Label, "\n", A, "\\end{equation}\n"]).
57
58env_align --> split,
59 remove([]),
60 maplist(phrase((split(`=`), align_row))),
61 insert("\\\\\n"),
62 peek(A, ["\\begin{align}\n", A, "\n\\end{align}\n"]).
63
64align_row([X|Y], [X, "=\\;& "|Y]).
65
66adj_space --> region, eh:sed_word(` ` -> ` `), overwrite.
67
68noindent --> region, eh:sed_word((`\n` + (*(` `))) -> `\n`), overwrite.
69
70number_order(E) :- number_order(E, Z), maplist(writeln, Z).
71
72tails([X],[[X]]).
73tails(X,[X|Xs]):- X=[_|X0], tails(X0, Xs).
74
75convolute([],[], []).
76convolute(As, Bs, Cs):-
77 reverse(Bs, B0s),
78 tails(B0s, TBs),
79 tails(As, TAs),
80 maplist(matrix:innerproduct, TAs, TBs, Cs).
81
82contract_white --> wor_sed(
83 (code(end_of_line), +(code(white);`ã`)) -> `\n`;
84 +(code(white); `ã`) -> ` `).
85
86tex_tex(A) --> region, texparse, eval(A), tex_codes, overwrite.
87
88try_slide(env(try, L), env(slide, [group(`åé¡`), env(try,L)]), [], [], true).
89try_slide(L, M, L, M, true):- listp(L).
93env_description --> elisp:paragraph, maplist(parse_description),
94 peek(A, ["\\begin{description}\n", A, "\\end{description}\n"]).
95
96parse_description(P, ["\\item[", X, "] ", Y, "\n"]):-
97 phrase(parse_description(X, Y), P).
98
99parse_description(X, Y) --> expr(*code(white)),
100 expr(X),
101 expr(+code(white)),
102 expr(rest,Y).
103
105edit_math(R) --> region, texparse,
106 eval(in_math_mode(R)),
107 tex_codes,
108 overwrite.
109
110do(X,Y):- conv_math(simple_greek, X, Y).
111
112dom --> region, texparse, eval(in_math_mode(simple_greek)), tex_codes, overwrite.
113
114a2g --> conv_math(map_alpha_greek).
115
116mtr --> region, texparse, eval(in_math_mode(map_alpha_greek)), tex_codes, overwrite.
117
118conv_math(Table) --> region, texparse, eval(conv_math(Table)), tex_codes, overwrite.
119
120conv_math(Table, dol(L0), dol(L), [], [], eval(in_math_mode(Table), L0, L)).
121conv_math(Table, ddol(L0), ddol(L), [], [], eval(in_math_mode(Table), L0, L)).
122conv_math(X, Y, X, Y, true):- listp(X).
123
124in_math_mode(T, X, Y, [], [], true):- call(T, X, Y).
125in_math_mode(_, group(X), group(Y), X, Y, true).
126in_math_mode(T, env(E, L0), env(E, L), [], [], eval( conv_math(T), L0, L) ).
127in_math_mode(_, X, Y, X, Y, true):- listp(X).
128
129map_alpha_greek(0'R, cs(alpha)).
130map_alpha_greek(0'U, cs(beta)).
131map_alpha_greek(0'J, cs(gamma)).
132map_alpha_greek(0'A, cs(alpha)).
133map_alpha_greek(0'B, cs(beta)).
134map_alpha_greek(0'C, cs(gamma)).
135map_alpha_greek(0'D, cs(delta)).
136map_alpha_greek(0'X, cs(xi)).
137map_alpha_greek(0'Y, cs(eta)).
138map_alpha_greek(0'Z, cs(zeta)).
139map_alpha_greek(0'a, cs(alpha)).
140map_alpha_greek(0'b, cs(beta)).
141map_alpha_greek(0'c, cs(gamma)).
142
143simple_greek(cs(greekA), cs(alpha)).
144simple_greek(cs(greekB), cs(beta)).
145simple_greek(cs(greekC), cs(gamma)).
146simple_greek(cs(greekD), cs(delta)).
147simple_greek(cs(greekX), cs(xi)).
148simple_greek(cs(greekY), cs(eta)).
149simple_greek(cs(greekZ), cs(zeta)).
150
151idx --> region, sed(idx), overwrite.
152
153idx([`\\index{x@`, Body, `}`, `\\`, Com, `{`, Body, `}`]) -->
154 `\\`, expr(*(code(alpha)), Com), `{`, expr(Body), `}`.
155
156idy --> region, make_index, overwrite.
157
158make_index(Body, [`\\index{x@`, Body, `}`, Body]).
159
160alpha_greek --> region, {alpha_greek_map(S)}, listsubst(S).
161
162alpha_greek_map(
163[(`A`,`\\alpha`), (`B`,`\\beta`), (`C`,`\\gamma`), (`D`,`\\delta`),
164(`F`,`\\phi`), (`L`,`\\lambda`), (`M`,`\\mu`), (`N`,`\\nu`),
165(`P`,`\\pi`), (`S`,`\\sigma`), (`T`,`\\tau`), (`X`,`\\xi`),
166(`Y`,`\\eta`), (`Z`,`\\zeta`), (`a`,`\\alpha`), (`b`,`\\beta`),
167(`c`,`\\gamma`), (`d`,`\\delta`), (`f`,`\\phi`), (`l`,`\\lambda`),
168(`m`,`\\mu`), (`n`,`\\nu`), (`p`,`\\pi`), (`s`,`\\sigma`),
169(`t`,`\\tau`), (`x`,`\\xi`), (`y`,`\\eta`), (`z`,`\\zeta`)]).
170
172
173mkrepsed(X, Dir) -->
174 current(A),
175 mkrepdcg(X, Dir),
176 cons([`\n`, X, `--> region, `, `sed(`, X, `), overwrite.\n\n`]),
177 cons(A),
178 phrase_on_car(commentout).
179
--> peek(A, [ `/***********\n`, A, `\n************/\n`]).
181
184mkrepdcg(Pred,Direction) --> split,
185 maplist(split(+` `)),
186 maplist(remove([])),
187 remove([]),
188 maplist(phrase((Direction, repdcg(Pred)))).
189
190repdcg(Pred, [X,Y], Z):- quote(X,QX), quote(Y,QY),
191 format(codes(Z), `~w(~s) --> ~s.~n`, [Pred,QX,QY]).
192
193ajaxCodes --> qstring, wrap_before_nl(`<script>smash(`, `);</script>`), overwrite.
194
195find --> sed(eh:replace).
196
197select_id_name([X,_,_,Y|_],[X,`,`,Y,`\n`]).
198select_id_name(_,`unallowed line`).
199
200op --> {elisp:send_to_lisp(`(shell-command \`open .\`)`)}.
201ot --> {elisp:send_to_lisp(`(mac-open-terminal)`)}.
202
203path --> peek(`(concat default-directory (buffer-name (current-buffer)))`),
204 lisp.
205
206ts --> {ensure_loaded(lib('convert-dcg'))}, region,sed(dcg_ts), overwrite.
207st --> {ensure_loaded(lib('convert-dcg'))}, region,sed(dcg_st), overwrite.
208
209t2h --> texparse, eval(tex2html).
210
212
214
215rmnl --> region, elisp:paragraph, remove([]), maplist(sed(rmnl)),
216 insert(`\n\n`), overwrite.
217
218rmnl([]) --> `\n`.
219
220linesort --> split, sort, overwrite.
221
222adj --> region, zenkaku_hankaku, overwrite.
223
224zenkaku_hankaku --> listsubst([ (`ã`,`ï¼`), (`ã`, `ï¼`), (`ã`, ` `), (`ï¼`,`(`),
225 (`ï¼`,`)`), (`ï½`, `{`), (`ï½`, `}`) ]).
226
227r(F)--> region, phrase(F).
228
229ro(F)--> region, phrase(F), overwrite.
230
231adj_punc --> {ensure_loaded(lib('convert-dcg'))}, region,sed(punct),overwrite.
232
233adjopp -->{ensure_loaded(lib('convert-dcg'))}, region,sed(punct_opp),overwrite.
234
235cr --> convert_rule.
236
237spaceproper --> expr(+(` `)).
238
239anc --> region, anc0, overwrite.
240
241anc0 --> expr(*(` `)), expr(X), spaceproper, expr(rest, Y),
242 peek([`<a href=\``, X, `\`>` , Y, `</a>\n`]).
243
251
252
253des --> region, env_description, overwrite.
254
255program --> region, peek(X, [`\\begin{program}\n`, X, `\\end{program}\n`]), overwrite.
256
260
261pre --> region, peek(A, [`<pre>\n`, A, `</pre>\n`]), overwrite.
262
263opt --> region, peek(A, [`<option>`, A, `</option>`]), overwrite.
264
265sli --> region, slide(slide, ``), overwrite.
266slif --> region, slide(slide, `[method=file]`), overwrite.
267wsli --> region, slide(wideslide, ``), overwrite.
268wslif --> region, slide(wideslide, `[method=file]`), overwrite.
269
270slide(E, Opts) --> expr(X + (+(`\n`))),
271 peek(B,[`\\begin{`, E, `}`, Opts, `{`, X, `}\n`, B, `\\end{`, E, `}\n`]).
272
273listcs --> region, listcs0, sort, insert(`\n`).
274
275listcs0 --> texparse, eval(cs), flatten.
276
277yacs([X]) --> tex_cs([cs(X)|Y],Y).
278yacs([]) --> [_].
279
280eol_space --> listsubst([(`\n`, ` `)]).
281
282named_env(Atom) --> expr(Opt), expr(`\n`), {atom_codes(Atom, Name)},
283 {Beg = [`\\begin{` , Name , `}[` , Opt , `]\n`]},
284 {End = [`\\end{`, Name , `}\n`]},
285 peek(Body, [Beg, Body, End]).
286
289
290tokenize(A) --> split(A), maplist(inverse(atom_codes)).
291
292section_slide --> region,
293 expr(_),
294 ( `\\subsection`; `\\section`),
295 sed(convert_slide),
296 peek(Body, [`\\begin{slide}`, Body, `\\end{slide}\n`]),
297 overwrite.
298
299convert_slide(`\n\\end{slide}\n\\begin{slide}`)-->
300 expr(*`\n`), ( `\\subsection`; `\\section`).
301
303cols(Ids) --> {maplist(aplam(#(x,nth1(x))), Ids, Call_list)},
304 maplist(dual(mapdual, Call_list)).
305
306mapdual(Data, Funs, Vals):- maplist(dual(Data), Funs, Vals).
307
308aplam(X,Y,Z):- simplify(@(X,Y),Z).
309
310aplam(X,Y,Z,U):- simplify(@(@(X,Y),Z),U).
311
312sort_col(I) --> predsort( compare_col(I) ).
313
314compare_col(I,D,L1,L2) :- nth1(I,L1,A1), nth1(I,L2,A2), compare(D,A1,A2).
315
316numbering(A, (N,[[CodesOfN, ` `, A]|X] ), (N1, X) ) :-
317 plus(1, N, N1), atom_codes(N, CodesOfN).
318
319numbering(X,Y):- foldl(numbering, X, (1,Y), (_,[])).
320
321fold_col(F,I,X,V,V1):- nth1(I,X,A), name(A1,A), call(F,A1,V,V1).
322
323fold_col(F,I,X,Y):- foldl(fold_col(F,I), X, 0, Y).
324
325fold_col(F,I) --> region, in, fold_col(F,I), atom_codes.
326
328line_number_nl --> region, split, current(X),
329 {length(X, N),
330 numlist(1, N, Ns),
331 maplist([I, Line, [C, `. `, Line, `\n`]] :- number_codes(I, C),
332 Ns, X, R)
333 },
334 peek(R),
335 overwrite.
336
338line_number --> line_number_l. 339
340line_number_l --> region, split, current(X),
341 { fold([Line, (J, A), (K, B)]:-
342 ( Line==[] -> A=[`\n`|B], K=J
343 ; K is J+1,
344 number_codes(K, C),
345 A=[[C, `. `, Line, `\n`]|B]
346 ),
347 X, (0, R), (_, []))
348 },
349 peek(R),
350 overwrite.
351
352line_number_r --> region, split, current(X),
353 { foldr([Line, (K, B), (J, A)]:-
354 ( Line==[] -> A=[`\n`|B], K=J
355 ; K is J+1,
356 number_codes(K, C),
357 A=[[C, `. `, Line, `\n`]|B]
358 ),
359 X, (_, []), (0, R))
360 },
361 peek(R),
362 overwrite.
363
364
365make_stable_marriage_problem(N, WP, MQ):- numlist(1, N, L),
366 maplist(X