1:- module(ml,
    2	  [parse_bind_context/2, bind_context/3,
    3	   parse_markup_body/4, parse_markup_text/4, eval_markup_text/2,
    4	   parse_phrase_save/1,
    5	   act/3, act/4
    6	   ]).    7
    8% ?- [util(ml)].
    9
   10:- use_module(util(snippets)).   11% :- use_module('../pac-core').
   12
   13		/***************************
   14		*     parse_markup_text    *
   15		***************************/
   16
   17% [2013/06/14]
   18
   19expand_arg(X,Y,Z,U,V):- pac:expand_arg(X, Y, Z, U, V).
   20
   21parse_markup_text(X, A, B) :- once(parse_markup_text(X, [], A, B)).
   22
   23% ?- ml:parse_markup_text(X, `@ (=).\n==\n`, V).
   24% ?- ml:parse_markup_text(X, `@a,b,c,\nd.\n123\n@f.\n456\n==\n==`, R).
   25% ?- ml:parse_markup_text(X, `@a,b,c,\nd.\n123\n@f.\n456\n`, R).
   26% ?- ml:parse_markup_text(X, `@ (=).\naaa\n==\n`, V).
   27% ?- ml:parse_markup_text(X, `@ (=).\n@ (=).\naaa\n==\n`, V).
   28% ?- ml:parse_markup_text(X, `@ (=).\n@ (=).\naaa\n==\nbbb\n`, V).
   29% ?- ml:parse_markup_text(X, `@ (=).\na\n`, V).
   30% ?- ml:parse_markup_text(X, `@ (=).\n==\n`, V).
   31% ?- ml:parse_markup_text(X, `@ pred([X,X]).\n==\n`, V).
   32% ?- ml:parse_markup_text(X, `@ pred([X,X]).\n1`, V).
   33%@ X = [com('pac#10', [49])],
   34% ?- ml:parse_markup_text(L, `@ pred([X,[X,X]]).\nhello`, Y), basic:smash(L).
   35
   36parse_markup_text(P, P, [], []).
   37parse_markup_text([G|P], Q) --> parse_tag(G),
   38	parse_markup_text(P, Q).
   39parse_markup_text(P, Q) --> line_feed(P, R),
   40	parse_markup_text(R, Q).
   41
   42% ?- ml:parse_tag(X, `@ (=).\n1`, R).
   43parse_tag(com(G, Body)) --> "@", skip_markup_open(Tag_codes),
   44	parse_markup_body(Body, []),
   45	{
   46   	 basic:herbrand_in_context(web, Tag_codes, G0), % <==== & の宣言なし
   47	 expand_arg(G0, [], G, Aux, []),
   48	 maplist(assert, Aux)
   49	}.
   50
   51
   52% [2013/09/09]
   53% parse_phrase_save(X) :- herbrand(_, X, G0)
   54%
   55eval_markup_text(X, Y) :- parse_markup_text(L, X, _),
   56	once(bind_context((L, []),  (Y, _))).
   57
   58%
   59act(G) --> act([], G).
   60
   61% ?- trace, ml:parse_phrase_save(`a`).
   62parse_phrase_save(X) :- herbrand_in_context(web, X, G0),
   63	 % prolog_load_context(module, M),
   64	 % expand_arg(G0, M, G, Aux, []),
   65	 expand_arg(G0, [], G, Aux, []),
   66	 maplist(assert, Aux),
   67	 nb_setval(phrase_tag, G).
   68
   69%
   70parse_markup_body(X, A, B):- once(parse_markup_body(X, [], A, B)).
   71
   72%
   73parse_markup_body(X, X)	--> markup_close.
   74parse_markup_body([C|X], Y) --> parse_tag(C),
   75	parse_markup_body(X, Y).
   76parse_markup_body(X, Y) --> line_feed(X, Z),
   77	parse_markup_body(Z, Y).
   78
   79% skip to the next line.
   80line_feed([0'\n|X], X)--> "\n".     % ' for the following not getting red.
   81line_feed([A|X], Y) --> [A], line_feed(X, Y).
   82line_feed(X, X)--> [].
   83
   84%
   85skip_markup_open(X, A, B):- once(skip_markup_open(X, [], A, B)).
   86%
   87skip_markup_open(X, X) --> ".\n".   % full stop.
   88skip_markup_open([A|X], Y) --> [A], skip_markup_open(X, Y).
   89skip_markup_open(X, X) --> [].
   90
   91%
   92markup_close --> "==", line_feed(_,[]).
   93markup_close --> "@end", line_feed(_,[]).
   94markup_close([], []).	% implicit multiple closure
   95
   96% ?- parse_bind_context(`split, pred([X,X]).\nh\ne\n`, Y), smash(Y)).
   97% ?- parse_bind_context(`pred([X,X]).\nhello`, Y), smash(Y).
   98% ?- parse_bind_context(`pred([X,[X,X]]).\nhello`, Y), smash(Y).
   99% ?- parse_bind_context(`(=).\nhello`, Y), smash(Y).
  100% ?- parse_bind_context(` (=).\nhello`, Y), smash(Y) .
  101% ?- parse_bind_context(`pred([X,X]).\n[1,2,3]\n`, V), smash(V).
  102% ?- parse_bind_context(`herbrand, pred([X,X]), term_codes.\n[1,2,3]\n`, V), smash(V).
  103% ?- parse_bind_context(`herbrand, maplist([X, f(X)]), term_codes.\n[1,2,3]\n`, V), smash(V).
  104
  105% ?- parse_bind_context(`dcl([a(1)]).\nhello`, Y), smash(Y).
  106% ?- eval_markup_text(`@dcl([a(1)]).\nhello`, Y), smash(Y).
  107% ?- eval_markup_text(`@   dcl([a(1)]).\nhello`, Y), smash(Y).
  108% ?- eval_markup_text(`@  pred([X,X]).\nhello`, Y), smash(Y).
  109
  110parse_bind_context(X, Y) :-  append(Tag, [0'., 0'\n | Rest], X), !,
  111   	 herbrand_in_context(web, Tag, G0),
  112	 expand_arg(G0, [], G, Aux, []),
  113	 maplist(assert, Aux),
  114	 once(bind_context((com(G, Rest), []),  (Y, _))).
  115
  116act(E, G, X, Y):-  once(bind_context(G, (X, E), (Y, _))).
  117
  118:- meta_predicate use_context(?, 2, ?).  119use_context(C, F, (X, C), (Y, C)):- call(F, X, Y).
  120
  121% bind_context/2
  122% ?- bind_context(([com(id, [])], []), X).
  123% ?- bind_context((com(obj(put([f(1)])),  []), []), X).
  124
  125bind_context(([A|B], E), ([A0|B0], F)):-
  126	bind_context((A, E), (A0, E0)),
  127	bind_context((B, E0), (B0, F)).
  128bind_context((com(F, A), E), (B, D)):-
  129	bind_context((A, E), (A0, E0)),
  130	bind_context(F, (A0, E0), (B, D)).
  131bind_context(X, X).
  132
  133% ?- bind_context(obj_put([a(hello)]), ([],[]), Y).
  134% ?- bind_context((obj_put([a(hello)]), obj_get([a(X)])), ([],[]), Y).
  135% ?- bind_context((get([a(A)]), peek(A)),([], [a(hello)]), Env).
  136
  137:- meta_predicate  bind_context(:, ?, ?).  138
  139bind_context(M:G) --> m_bind_context(G, M).
  140bind_context(G)	  --> m_bind_context(G, []).
  141
  142%
  143m_bind_context(M:G, _)	--> m_bind_context(G, M).
  144m_bind_context((F,G), M)--> m_bind_context(F, M),
  145	m_bind_context(G, M).
  146m_bind_context({F}, []) --> {once(F)}.
  147m_bind_context({F}, M)	--> {M:once(F)}.
  148m_bind_context(&(F), [])--> phrase(F).
  149m_bind_context(&(F), M)	--> phrase(M:F).
  150m_bind_context(dcl(D), M) --> m_bind_context(obj(push(D)), M).
  151m_bind_context(context(E), _, (X, E), (X, E)).
  152m_bind_context(context(C, F), M, (X, C), (Y, C)):- once(x_phrase(F, M, X, Y)).
  153m_bind_context(obj(F), _, (X, C), (X, D)) :- obj:obj(F, C, D).
  154m_bind_context(get(A), _, (X, C), (X, D)) :- obj:obj_get(A, C, D).
  155m_bind_context(put(A), _, (X, C), (X, D)) :- obj:obj_put(A, C, D).
  156m_bind_context(save, _, (X, C), ([], D))  :- obj:obj_put([acc(X)], C, D).
  157m_bind_context(restore, _, (_, C), (X, D)) :- obj:obj_pull([acc(X)], C, D).
  158m_bind_context(F, M, (X, C), (Y, C)):- 	once(x_phrase(F, M, X, Y)).
  159
  160%
  161x_phrase((A,B), M, X, Y):- x_phrase(A, M, X, X0),
  162	x_phrase(B, M, X0, Y).
  163x_phrase(A;B, M, X, Y):-
  164	(	x_phrase(A, M, X, Y)
  165	;	x_phrase(B, M, X, Y)).
  166x_phrase(\+(A), M, X, Y):- \+ x_phrase(A, M, X, Y).
  167x_phrase(once(A), M, X, Y):- once(x_phrase(A, M, X, Y)).
  168x_phrase(M:A, _, X, Y):- x_phrase(A, M, X, Y).
  169x_phrase(F, [], X, Y):- call(F, X, Y).
  170x_phrase(F, M, X, Y):- call(M:F, X, Y)