12:- module(dcg_meta,[
13 do_dcg_util_tests/0,
14 isVar/1,
15 isQVar/1,
16 isVarOrVAR/1,
17 file_eof//0,
18 charvar/1,
19 cspace//0,
20 cwhite//0,
21 mw//1,
22 bx/1,
23 zalwayz//1,
24 zalwayz/1,
25 one_blank//0,
26 set_dcg_meta_reader_options/2,
27 phrase_from_stream_nd/2,
28 parse_meta_term/3,
29 read_string_until//2,
30 read_string_until_no_esc//2,
31 dcgOneOrMore//1,
32 dcgOptional//1,
33 dcgZeroOrMore//1,
34 dcgOptionalGreedy//1,
35 dcgAnd//2,
36 dcgAnd//3,
37 dcgAnd//4,
38 dcgMust//1,
39 40 dcgSeqLen//1,
41 dcgOr//2,
42 dcgNot//1,
43 theString//1,
44 theString//2,
45 theText//1,
46 theCode//1,
47 dcgLenBetween/4,
48 notrace_catch_fail/1,
49 notrace_catch_fail/3,
50 51 do_dcgTest/3,
52 do_dcgTest_startsWith/3,
53 decl_dcgTest_startsWith/2,
54 decl_dcgTest_startsWith/3,
55 decl_dcgTest/2,
56 decl_dcgTest/3,
57 dcgReorder/4
58 ]).
67:- set_module(class(library)). 68
69:- meta_predicate track_stream(*,0). 70:- meta_predicate read_string_until(*,*,//,?,?). 71:- meta_predicate read_string_until_pairs(*,//,?,?). 72
73:- system:use_module(library(listing)). 74:- system:use_module(library(lists)). 75:- system:use_module(library(time)). 76:- system:use_module(library(readutil)). 77
78
79:- dynamic(t_l:dcg_meta_reader_options/2). 80:- thread_local(t_l:dcg_meta_reader_options/2). 81
82set_dcg_meta_reader_options(N,V):- retractall(t_l:dcg_meta_reader_options(N,_)),asserta(t_l:dcg_meta_reader_options(N,V)).
83get_dcg_meta_reader_options(N,V):- t_l:dcg_meta_reader_options(N,V).
84
85
86
88user:portray(List):- compound(List),compound_name_arity([_,_],F,A),compound_name_arity(List,F,A),
89 List=[H|_],integer(H),H>9,user_portray_dcg_seq(List).
90
91user_portray_dcg_seq(List):- \+ is_list(List),!,between(32,1,Len),l_length(Left,Len),append(Left,_,List), ground(Left),!,
92 catch(atom_codes(W,Left),_,fail),format("|~w ___|",[W]).
93user_portray_dcg_seq(List):- is_codelist(List), catch(atom_codes(Atom,List),_,fail),l_length(List,Len),
94 (Len < 32 -> format("`~w`",[Atom]) ;
95 (l_length(Left,26),append(Left,_Rest,List),format(atom(Print),"~s",[Left]),format("|~w ... |",[Print]))).
96
97l_length(L,N):- integer(N),!,length(L,N).
98l_length(L,N):- is_list(L),!,length(L,N).
99l_length(L,N):- !,fail,length(L,N),!.
100l_length([_|L],N):- !, l_length0(L,N1),N is N1+1.
101l_length0(L,N):- var(L),!,N=0.
102l_length0([_|L],N):- !, l_length0(L,N1),N is N1+1.
103l_length0(_,1).
104
105
108
109:- meta_predicate bx(0). 110:- meta_predicate expr_with_text(*,2,*,*,*). 111:- meta_predicate locally_setval(*,*,0). 112:- meta_predicate notrace_catch_fail(0). 113:- meta_predicate notrace_catch_fail(0,?,0). 114:- meta_predicate phrase_from_buffer_codes(//,*). 115:- meta_predicate phrase_from_buffer_codes_nd(//,*). 116:- meta_predicate phrase_from_pending_stream(*,//,*). 117:- meta_predicate phrase_from_pending_stream(//,?). 118:- meta_predicate phrase_from_stream_lazy_part(//,*). 119:- meta_predicate read_string_until(*,*,//,?,?). 120:- meta_predicate read_string_until_no_esc(*,//,?,?). 121:- meta_predicate read_string_until_pairs(*,//,?,?). 122:- meta_predicate zalwayz(//,?,?). 123:- meta_predicate(zalwayz(0)). 124:- meta_predicate track_stream(*,0). 125:- meta_predicate always_b(//,?,?). 126:- meta_predicate phrase_from_stream_nd(//,+). 127:- meta_predicate read_string_until(*,//,?,?). 128
129
130:- meta_predicate dcgLeftOfMid(?,//,?,?). 131:- meta_predicate dcgLeftMidRight(//,//,//,?,?). 132
133:- meta_predicate dcgAnd(//,//,//,//,?,?). 134:- meta_predicate dcgAnd(//,//,//,?,?). 135:- meta_predicate dcgAnd(//,//,?,?). 136:- meta_predicate dcgAndRest(//,*,*,*). 137:- meta_predicate dcgBoth(//,//,*,*). 138:- meta_predicate dcgIgnore(//,?,?). 139:- meta_predicate dcgLeftOf(//,*,*,*). 140:- meta_predicate dcgMust(//,?,?). 141:- meta_predicate dcgMidLeft(//,*,//,*,?). 142:- meta_predicate dcgNot(//,?,?). 143:- meta_predicate dcgOnce(//,?,?). 144:- meta_predicate dcgOnceOr(//,//,?,?). 145:- meta_predicate dcgOneOrMore(//,?,*). 146:- meta_predicate dcgOptional(//,?,?). 147:- meta_predicate dcgOptionalGreedy(//,?,?). 148:- meta_predicate dcgOr(//,//,//,//,//,?,?). 149:- meta_predicate dcgOr(//,//,//,//,?,?). 150:- meta_predicate dcgOr(//,//,//,?,?). 151:- meta_predicate dcgOr(//,//,?,?). 152:- meta_predicate dcgReorder(//,//,?,?). 153:- meta_predicate dcgStartsWith(//,?,?). 154:- meta_predicate dcgStartsWith0(//,?,*). 155:- meta_predicate dcgStartsWith1(//,?,?). 156:- meta_predicate dcgTraceOnFailure(0). 157:- meta_predicate dcgWhile(?,//,?,?). 158:- meta_predicate dcgZeroOrMore(//,?,*). 159:- meta_predicate decl_dcgTest(?,?). 160:- meta_predicate decl_dcgTest(?,?,?). 161:- meta_predicate decl_dcgTest_startsWith(?,?,?). 162:- meta_predicate do_dcgTest(*,//,0). 163:- meta_predicate do_dcgTest_startsWith(?,//,?). 164:- meta_predicate suggestVar(2,*,?). 165:- meta_predicate theAll(//,?,?). 166:- meta_predicate theCode(?,?,?). 167
172
174
175:- if(current_prolog_flag(dialect,swi)). 176:- dynamic(double_quotes_was_in_dcg/1). 177:- current_prolog_flag(double_quotes,WAS),asserta(double_quotes_was_in_dcg(WAS)). 178:- retract(double_quotes_was_in_dcg(WAS)),set_prolog_flag(double_quotes,WAS). 179:- current_prolog_flag(double_quotes,WAS),asserta(double_quotes_was_in_dcg(WAS)). 180:- set_prolog_flag(double_quotes,string). 181:- endif. 182
183isVarOrVAR(V):-var(V),!.
184isVarOrVAR('$VAR'(_)).
185isVar(V):- (isVarOrVAR(V);isQVar(V)),!.
186isQVar(Cvar):-atom(Cvar),atom_concat('?',_,Cvar).
187
188:- dynamic
189 decl_dcgTest/2,
190 decl_dcgTest/3,
191 decl_dcgTest_startsWith/2,
192 decl_dcgTest_startsWith/3. 193
194
195decl_dcgTest(X,Y):- nonvar(Y),!,do_dcgTest(X,Y,true).
196decl_dcgTest(X,Y,Z):- nonvar(Y),!,do_dcgTest(X,Y,Z).
197decl_dcgTest_startsWith(X,Y):- nonvar(Y),!,do_dcgTest(X,dcgStartsWith(Y),true).
198decl_dcgTest_startsWith(X,Y,Z):- nonvar(Y),!,do_dcgTest(X,dcgStartsWith(Y),Z).
202
203getText([],[]).
204getText(L,Txt):-member([txt|Txt],L),!.
205getText([L|List],Text):-getText(L,Text1),getText(List,Text2),append(Text1,Text2,Text),!.
206getText(F,S):-compound_name_arity(F,_,3),arg(2,F,S),!.
207getText(S,S).
208
209
213:- style_check(-discontiguous). 214
215
216
217equals_text(S,Data):- is_list(Data),member([txt,S0],Data),!,equals_text(S,S0).
218equals_text(S,S):- !.
220equals_text(S,S0):- var(S0),text_to_string(S,S0),!.
221equals_text(S,S0):- var(S),text_to_string(S0,S),!.
222equals_text(S,S0):- text_to_string(S,SS),text_to_string(S0,SS).
223
224decl_dcgTest("this is text",theText([this,is,text])).
225
227
228theText(Text) --> {Text==[],!},[].
229theText([S|Text]) --> {nonvar(S),!},theText0(S),!,theText(Text).
230
231theText([S|Text]) --> theText0(S),theText(Text).
232theText([]) --> [].
233
235
237
239theText0(_,W,_):- W==[],!,fail.
240theText0(S) --> {atomic(S),atom_concat('"',Right,S),atom_concat(New,'"',Right),!},theText(New).
241theText0(S) --> {atomic(S),concat_atom([W1,W2|List],' ',S),!},theText([W1,W2|List]).
242theText0(S) --> {!}, [Data],{equals_text(S,Data)}.
243
244
245
246
247decl_dcgTest("this is a string",theString("this is a string")).
248theString(String) --> theString(String, " ").
249
250atomic_to_string(S,S):- string(S),!.
251atomic_to_string(S,Str):-sformat(Str,'~w',[S]).
252
253atomics_to_string_str(L,S,A):-catch(atomics_to_string(L,S,A),_,fail).
254atomics_to_string_str(L,S,A):-atomics_to_string_str0(L,S,A).
255
256atomics_to_string_str0([],_Sep,""):-!.
257atomics_to_string_str0([S],_Sep,String):-atom(S),!,string_to_atom(String,S).
258atomics_to_string_str0([S],_Sep,S):- string(S),!.
259atomics_to_string_str0([S|Text],Sep,String):-
260 atomic_to_string(S,StrL),
261 atomics_to_string_str0(Text,Sep,StrR),!,
262 new_a2s([StrL,StrR],Sep,String).
263
265theString(String,Sep) --> [S|Text], {atomics_to_string_str([S|Text],Sep,String),!}.
266
267decl_dcgTest_startsWith([a,b|_],theCode(X=1),X==1).
268decl_dcgTest_startsWith("anything",theCode(X=1),X==1).
269decl_dcgTest("",theCode(X=1),X==1).
270theCode(Code) --> [],{Code}.
271
272
273decl_dcgTest([a,b|C],theAll([a,b|C])).
275theAll(X, B, C) :- var(X),X=B,C=[],!.
276theAll(X, B, C) :- phrase(X, B, C).
277
278decl_dcgTest([a,b|C],theRest(X),X==[a,b|C]).
279theRest(X, X, []).
280
281
282
283theName(Var,S,_) :-getText(S,Text),suggestVar(=,Text,Var),!.
284
286
287suggestVar(_Gensym,Subj,Subj):-var(Subj),!. 288suggestVar(_Gensym,Subj,_Subj2):-var(Subj),!. 289suggestVar(Gensym,[W|ORDS],Subj):-!,ignore((once((nonvar(ORDS),toPropercase([W|ORDS],Proper),concat_atom(['Hypothetic'|Proper],'-',Suj),call(Gensym,Suj,SubjSl),ignore(SubjSl=Subj))))),!.
291suggestVar(_Gensym,[],_):-!. 292suggestVar(Gensym,A,Subj):-suggestVar(Gensym,[A],Subj),!.
293
294
295
297makeName(A,A):-!.
298makeName(Subj,Subj2):-var(Subj),!,term_to_atom(Subj,Atom),makeName(['Hypothetic',Atom],Subj2),!.
299makeName([],Subj2):-!,makeName(_Subj,Subj2),!.
300makeName(Subj,Subj2):-atom(Subj),atom_concat('?',Sub2,Subj),!,makeName(Sub2,Subj2),!.
301makeName(A,Subj):-atom(A),!,makeName([A],Subj),!.
302makeName([W|ORDS],Subj):-nonvar(ORDS),!,toPropercase([W|ORDS],PCASE),concat_atom(['Hypothetic'|PCASE],'-',Suj),gensym(Suj,Subj),!.
303
304leastOne([_CO|_LSS]).
305
309
312:- export(dcgReorder//2). 313dcgReorder(P, C, B, E):- phrase(P, B, D), phrase(C, D, E).
314
315:- export(dcgSeq//2). 316dcgSeq(X,Y,[S0,S1|SS],E):-phrase((X,Y),[S0,S1|SS],E).
317
318:- export(dcgBoth//2). 319dcgBoth(DCG1,DCG2,S,R) :- append(L,R,S),phrase(DCG1,L,[]),once(phrase(DCG2,L,[])).
320
321dcgAnd(DCG1,DCG2,DCG3,DCG4,S,E) :- phrase(DCG1,S,E),phrase(DCG2,S,E),phrase(DCG3,S,E),phrase(DCG4,S,E).
322dcgAnd(DCG1,DCG2,DCG3,S,E) :- phrase(DCG1,S,E),phrase(DCG2,S,E),phrase(DCG3,S,E).
323dcgAnd(DCG1,DCG2,S,E) :- phrase(DCG1,S,E),phrase(DCG2,S,E).
324dcgOr(DCG1,DCG2,DCG3,DCG4,DCG5,S,E) :- phrase(DCG1,S,E);phrase(DCG2,S,E);phrase(DCG3,S,E);phrase(DCG4,S,E);phrase(DCG5,S,E).
325dcgOr(DCG1,DCG2,DCG3,DCG4,S,E) :- phrase(DCG1,S,E);phrase(DCG2,S,E);phrase(DCG3,S,E);phrase(DCG4,S,E).
326dcgOr(DCG1,DCG2,DCG3,S,E) :- phrase(DCG1,S,E);phrase(DCG2,S,E);phrase(DCG3,S,E).
327dcgOr(DCG1,DCG2,S,E) :- phrase(DCG1,S,E);phrase(DCG2,S,E).
328dcgOnceOr(DCG1,DCG2,S,E) :- phrase(DCG1,S,E)->true;phrase(DCG2,S,E).
329dcgNot(DCG2,S,E) :- \+ phrase(DCG2,S,E).
330dcgIgnore(DCG2,S,E) :- ignore(phrase(DCG2,S,E)).
331dcgOnce(DCG2,S,E) :- once(phrase(DCG2,S,E)).
332
333dcgWhile(True,Frag)-->dcgAnd(dcgOneOrMore(True),Frag).
334
335dcgMust((DCG1,List),S,E) :- is_list(List),!,must((phrase(DCG1,S,SE),phrase(List,SE,E))).
336dcgMust(DCG1,S,E) :- must(phrase(DCG1,S,E)).
337
338dcgSeqLen(Len, FB, END) :-
339 l_length(CD, Len),
340 '$append'(CD, END, FB).
341
342
345dcgLenBetween(Start,Start) --> {!}, dcgSeqLen(Start),{!}.
346dcgLenBetween(Start,End, FB, END) :- FB==[],!, ((Start>End -> between(End,Start,0) ; between(Start,End,0))),must(END=[]).
347dcgLenBetween(Start,End) --> dcgOnceOr(dcgSeqLen(Start),({(Start>End -> Next is Start-1 ; Next is Start+1)},dcgLenBetween(Next,End))).
348dcgLenBetween(Len, Start, End, FB, END) :-
349 (l_length(CD, Start),
350 '$append'(CD, END, FB)) -> ignore(End=Start) ;
351 (
352 (Start>End -> Next is Start-1 ; Next is Start+1),
353 dcgLenBetween(Len, Next, End, FB, END)
354 ).
355
356
357
358
359dcgOneOrMore(True) --> True,dcgZeroOrMore(True),{!}.
360
361dcgZeroOrMore(True) --> True,{!},dcgZeroOrMore(True),{!}.
362dcgZeroOrMore(_True) -->[].
363
364dcgLeftOf(Mid,[Left|T],S,[MidT|RightT]):-append([Left|T],[MidT|RightT],S),phrase(Mid,MidT),phrase([Left|T],_LeftT).
365
366
367dcgLeftOfMid([Left|T],Mid,S,[MidT|RightT]):-append([Left|T],[MidT|RightT],S),phrase(Mid,MidT),phrase([Left|T],_LeftT).
368
369dcgLeftMidRight(Left,Mid,Right) --> dcgLeftOfMid(LeftL,Mid),{phrase(Left,LeftL,[])},Right.
370
371dcgMidLeft(Mid,Left,Right) --> dcgLeftOf(Mid,Left),Right.
372
373dcgNone --> [].
374
375dcgOptional(A)--> dcgOnce(dcgOr(A,dcgNone)).
376
377dcgOptionalGreedy(A)--> dcgOnce(dcgOr(A,dcgNone)).
378
379dcgTraceOnFailure(X):-once(X;(dtrace(X))).
380
381:- export(capitalized//1). 382capitalized([W|Text]) --> theText([W|Text]),{atom_codes(W,[C|_Odes]),is_upper(C)}.
383
384substAll(B,[],_R,B):-!.
385substAll(B,[F|L],R,A):-subst(B,F,R,M),substAll(M,L,R,A).
386
387substEach(B,[],B):-!.
388substEach(B,[F-R|L],A):-subst(B,F,R,M),substEach(M,L,A).
389
390dcgAndRest(TheType,_TODO,[S|MORE],[]) :- phrase(TheType,[S],[]),phrase(TheType,[S|MORE],[]).
391
395
399dcgStartsWith(TheType,SMORE,SMORE) :- phrase(TheType,SMORE,_).
400
402decl_dcgTest_startsWith("this is text",dcgStartsWith(theText(["this","is"]))).
403
404
405:- export(dcgStartsWith1//1). 409dcgStartsWith1(TheType,[S|MORE],[S|MORE]) :- phrase(TheType,[S],[]).
410
412decl_dcgTest_startsWith("this is text",dcgStartsWith1(theText(["this"]))).
413
414
418dcgStartsWith0(TheType,SMORE,[]) :- phrase(TheType,SMORE,_).
419
421decl_dcgTest("this is text",dcgStartsWith0(theText(["this",is]))).
422
426
427:- export(do_dcg_util_tests/0). 428do_dcg_util_tests:-
429 forall(decl_dcgTest(List,Phrase,Call),'@'((do_dcgTest(List,Phrase,Call)),dcg_meta)),
430 forall(decl_dcgTest_startsWith(List,Phrase,Call),'@'((do_dcgTest_startsWith(List,Phrase,Call)),dcg_meta)).
431
432
433do_dcgTest(Input,DCG,Call):- to_word_list(Input,List),OTEST=do_dcgTest(Input,DCG,Call),copy_term(DCG:OTEST,CDCG:TEST),
434 once((phrase(DCG,List,Slack),Call,(Slack==[]->dmsg(passed(CDCG,TEST,OTEST));dmsg(warn(Slack,OTEST))))).
435do_dcgTest(Input,DCG,Call):- dmsg(warn(failed(DCG, do_dcgTest(Input,DCG,Call)))).
436
437
438do_dcgTest_startsWith(Input,DCG,Call):- to_word_list(Input,List),OTEST=do_dcgTest(Input,DCG,Call),copy_term(DCG:OTEST,CDCG:TEST),
439 once((phrase(DCG,List,Slack),Call,(Slack==[]->wdmsg(warn(CDCG,TEST,OTEST));dmsg(passed(CDCG,TEST,OTEST))))).
440do_dcgTest_startsWith(Input,DCG,Call):- wdmsg(warn(failed(DCG, do_dcgTest_startsWith(Input,DCG,Call)))).
441
442
443decl_dcgTest(List,Phrase,true):-decl_dcgTest(List,Phrase).
444decl_dcgTest_startsWith(List,Phrase,true):-decl_dcgTest_startsWith(List,Phrase).
445
446
447
449
450
451
452
454dumpList(_,AB):-dmsg(dumpList(AB)),!.
455
456dumpList(_,[]):-!.
459
461:- if(current_prolog_flag(dialect,swi)). 462:- retract(double_quotes_was_in_dcg(WAS)),set_prolog_flag(double_quotes,WAS). 463:- endif. 464
465
466optional(X) --> cwhite, !, optional(X).
467optional(X) --> X,!, owhite.
468optional(_) --> [].
469optional(O,X) --> {debug_var(X,O),append_term(X,O,XO)},!,optional(XO).
470
471mw(X) --> cspace,!, mw(X).
472mw(X) --> X,!, owhite.
473
474owhite --> {quietly_pfs(nb_current('$dcgm_whitespace',preserve))},!.
475owhite --> cwhite.
476owhite --> [].
477
478
479
481cwhite --> cspace,!,owhite.
482cwhite --> {quietly_pfs(nb_current('$dcgm_comments',consume))},file_comment_expr(CMT),!,{assert(t_l:'$last_comment'(CMT))},!,owhite.
483cwhite --> {quietly_pfs(nb_current('$dcgm_whitespace',preserve))}, !, {fail}.
484
485cspace --> [C], {nonvar(C),charvar(C),!,C\==10,bx(C =< 32)}.
486
487charvar(C):- integer(C)-> true; (writeln(charvar(C)),dumpST,writeln(charvar(C)),only_debug(break),fail).
488
489one_blank --> [C],!,{C =< 32}.
490
491:- meta_predicate(file_meta_with_comments(2,+,+,-)). 492:- meta_predicate(file_meta_with_comments0(2,+,+,-)).(Pred, O, A, B) :-
501 file_meta_with_comments0(Pred, O, A, B).
502
(Pred, O) --> one_blank,!,file_meta_with_comments(Pred, O). 504file_meta_with_comments0(_Pred, C) --> file_comment_expr(C),!.
505file_meta_with_comments0(_Pred, EOF) --> file_eof,!,{end_of_file=EOF}.
506
507file_meta_with_comments0(Pred, Out,S,E):- append_term(Pred,Out,PredOut),
508 \+ t_l:dcg_meta_reader_options(with_text,true),!,phrase(PredOut,S,E),!.
509file_meta_with_comments0(Pred, Out,S,E):- append_term(Pred,O,PredO),
510 expr_with_text(Out,PredO,O,S,E),!.
511
(C)--> {get_dcg_meta_reader_options(file_comment_reader,Pred), append_term(Pred,C,PredC)},PredC.
513
514read_string_until_no_esc(String,End)--> dcg_notrace(read_string_until(noesc,String,End)).
515read_string_until(String,End)--> read_string_until(esc,String,End).
516
517read_string_until(_,[],eoln,S,E):- S==[],!,E=[].
518read_string_until(esc,[C|S],End) --> `\\`,!, zalwayz(escaped_char(C)),!,
519 read_string_until(esc,S,End),!.
520read_string_until(_,[],End) --> End, !.
522read_string_until(Esc,[C|S],End) --> [C],!,read_string_until(Esc,S,End),!.
524
525read_string_until_pairs([C|S],End) --> `\\`,!, zalwayz(escaped_char(C)),!, read_string_until_pairs(S,End).
526read_string_until_pairs([],HB) --> HB, !.
527read_string_until_pairs([C|S],HB) --> [C],read_string_until_pairs(S,HB).
528
530escaped_char(10) --> `n`,!.
531escaped_char(13) --> `r`,!.
532escaped_char(9) --> `t`,!.
533escaped_char(C) --> [C],!.
534escaped_char(C) --> eoln,!,[C].
535escaped_char(E) --> [C], {atom_codes(Format,[92,C]),format(codes([E|_]),Format,[])},!.
536escaped_char(Code) --> [C], {escape_to_char([C],Code)},!.
537
538escape_to_char(Txt,Code):- notrace_catch_fail((sformat(S,'_=`\\~s`',[Txt]),read_from_chars(S,_=[Code]))),!.
539
540zalwayz_debug:-!.
541zalwayz_debug:- current_prolog_flag(zalwayz,debug).
542
543never_zalwayz(Goal):-
544 locally(current_prolog_flag(zalwayz,false),Goal).
545
546zalwayz_zalwayz(Goal):-
547 locally(current_prolog_flag(zalwayz,debug),Goal).
548
549
550zalwayz(G,H,T):- \+ zalwayz_debug, !, phrase(G,H,T).
551zalwayz(G,H,T):- phrase(G,H,T),!.
552zalwayz(G,H,T):- nb_current('$translation_stream',S),is_stream(S), \+ stream_property(S,tty(true)),!,always_b(G,H,T).
553zalwayz(G,H,T):- always_b(G,H,T).
554
555only_debug(G):- \+ zalwayz_debug, !, nop(G),!.
556only_debug(G):- !, call(G).
557
559zalwayz(G):- \+ zalwayz_debug, !, quietly_pfs(catch(G,_,fail)),!.
560zalwayz(G):- must(G).
562
563always_b(G,H,T):- only_debug(break),H=[_|_],writeq(phrase_h(G,H,T)),dcg_print_start_of(H),writeq(phrase(G,H,T)),!,trace,ignore(rtrace(phrase(G,H,T))),!,quietly_pfs,dcg_print_start_of(H),writeq(phrase(G,H,T)), only_debug(break),!,fail.
564always_b(G,H,T):- writeq(phrase(G,H,T)),dcg_print_start_of(H),writeq(phrase(G,H,T)),!,only_debug(trace),ignore(rtrace(phrase(G,H,T))),!,quietly_pfs,dcg_print_start_of(H),writeq(phrase(G,H,T)), break,!,fail.
565
566dcg_print_start_of(H):- (l_length(L,3000);l_length(L,300);l_length(L,30);l_length(L,10);l_length(L,1);l_length(L,0)),append(L,_,H),!,format('~NTEXT: ~s~n',[L]),!.
567bx(CT2):- notrace_catch_fail(CT2,E,(writeq(E:CT2),only_debug(break))),!.
568notrace_catch_fail(G,E,C):- catch(G,E,C),!.
569notrace_catch_fail(G):- quietly_pfs(catch(G,_,fail)),!.
570clean_fromt_ws([],[]).
571clean_fromt_ws([D|DCodes],Codes):-
572 ((\+ char_type(D,white), \+ char_type(D,end_of_line)) -> [D|DCodes]=Codes ; clean_fromt_ws(DCodes,Codes)).
573
574:- export(txt_to_codes/2). 575txt_to_codes(S,Codes):- quietly_pfs(is_stream(S)),!,stream_to_lazy_list(S,Codes),!.
576txt_to_codes(AttVar,AttVarO):- quietly_pfs(attvar(AttVar)),!,AttVarO=AttVar.
579txt_to_codes(Text,Codes):- notrace_catch_fail((text_to_string_safe(Text,String),!,string_codes(String,Codes))),!.
580
581phrase_from_pending_stream(Grammar, In):-
582 remove_pending_buffer_codes(In,CodesPrev),
583 phrase_from_pending_stream(CodesPrev, Grammar, In).
584
585phrase_from_pending_stream(CodesPrev,Grammar,In):- CodesPrev=[_,_|_],
586 phrase(Grammar,CodesPrev,NewBuffer),!,
587 append_buffer_codes(In,NewBuffer).
588phrase_from_pending_stream(CodesPrev,Grammar,In):-
589 b_setval('$translation_stream',In),
590 read_codes_from_pending_input(In,Codes),!,
591 ((quietly_pfs(is_eof_codes(Codes))) ->
592 phrase_from_eof(Grammar, In);
593 (append(CodesPrev,Codes,NewCodes), !,
594 (phrase(Grammar, NewCodes, NewBuffer)
595 -> append_buffer_codes(In,NewBuffer);
596 phrase_from_pending_stream(NewCodes,Grammar,In)))).
597
598
599dcg_notrace(G,S,E):- tracing -> setup_call_cleanup(notrace,phrase(G,S,E),trace); phrase(G,S,E).
600my_lazy_list_location(Loc,S,S):- attvar(S), quietly_pfs(catch(lazy_list_location(Loc,S,S),_,fail)),!.
601my_lazy_list_location(file(_,_,-1,-1))-->[].
602
603
604track_stream(_In,G):- !,G.
605track_stream(In,G):- \+ is_stream(In),!,G.
606track_stream(In,G):-
607 b_setval('$translation_stream',In),
608 notrace_catch_fail(stream_position(In,Pos,Pos),_,true),
609 character_count(In,Chars),
610 stream_property(In,encoding(Was)),
611 (setup_call_catcher_cleanup(
612 nop(sset_stream(In,encoding(octet))),
613 (ignore(notrace_catch_fail(line_count(In,Line),_,(Line = -1))),
614 b_setval('$translation_line',Line-Chars),
615 ((G),!)),
616 Catcher,
617 true)->true;Catcher=fail),
618 track_stream_cleanup(Catcher,In,Was,Pos).
619
620track_stream_cleanup(Exit,In,Was,_Pos):-
621 (Exit==exit ; Exit == (!)),!,
622 sset_stream(In,encoding(Was)).
623track_stream_cleanup(Catcher,In,Was,Pos):-
624 sset_stream(In,encoding(Was)),
625 ((nonvar(Pos),supports_seek(In))->stream_position(In,_Was,Pos);true),!,
626 (compound(Catcher)-> (arg(1,Catcher,E),throw(E)) ; fail).
627
628sset_stream(S,P):- functor(P,F,A),functor(W,F,A), stream_property(S,W),!,
629 (P=@=W->true;notrace(catch(set_stream(S,P),_,true))).
630
631
632:- meta_predicate locally_setval(*,*,0). 633
634locally_setval(Name,Value,Goal):-
635 (nb_current(Name,Was)->true;Was=[]),
636 b_setval(Name,Value),
637 call(Goal),
638 b_setval(Name,Was).
639
640
641
642:- thread_local(t_l:'$fake_buffer_codes'/2). 643
648parse_meta_stream(Pred, S,Expr):-
649 catch(
650 parse_meta_stream_1(Pred, S,Expr),
651 end_of_stream_signal(_Gram,S),
652 Expr=end_of_file).
653
654parse_meta_stream_1(Pred, S,Expr):-
655 phrase_from_stream_nd(file_meta_with_comments(Pred,Expr),S).
656
657
658:- meta_predicate(quietly_pfs(0)). 659quietly_pfs(G):- !, call(G).
662
663is_tty_alive(In):-
664 stream_property(In,tty(true)),
665 stream_property(In,mode(read)),
666 stream_property(In,end_of_stream(not)).
667
668show_stream_info(In):-
669 quietly_pfs((forall(stream_property(In,(BUF)),
670 (writeq(show_stream_info(In,(BUF))),nl)))),!.
671
672phrase_from_stream_nd(Grammar,In):-
673 quietly_pfs((peek_pending_codes(In,Codes)->Codes=[_,_|_],
674 remove_pending_buffer_codes(In,_))),
675 (phrase(Grammar,Codes,NewBuffer)-> append_buffer_codes(In,NewBuffer);(append_buffer_codes(In,Codes),fail)).
676
677phrase_from_stream_nd(Grammar, In) :- at_end_of_stream(In),
678 peek_pending_codes(In,Pend),is_eof_codes(Pend),!,phrase_from_eof(Grammar, In). 680
681phrase_from_stream_nd(Grammar, In) :- stream_property(In,tty(true)),!,
682 repeat,
683 (is_tty_alive(In)-> true ; throw(end_of_stream_signal(Grammar,In))),
684 phrase_from_pending_stream(Grammar, In).
685
686phrase_from_stream_nd(Grammar, In) :- supports_seek(In),
687 ignore(notrace_catch_fail(sset_stream(In,buffer_size(819200)))),
688 ignore(notrace_catch_fail(sset_stream(In,buffer_size(16384)))),
689 ignore(notrace_catch_fail(sset_stream(In,encoding(octet)))),
690 ignore(notrace_catch_fail(sset_stream(In,timeout(3.0)))),
691 692 repeat, (at_end_of_stream(In)->(!,fail);true),
693
694 character_count(In, FailToPosition),
695 ((phrase_from_stream_lazy_part(Grammar, In) *-> true ; (seek(In,FailToPosition,bof,_),!,fail))),!.
696
697phrase_from_stream_nd(Grammar, In) :- \+ supports_seek(In),!,
698 if_debugging(sreader,show_stream_info(In)),
699 read_stream_to_codes(In,Codes),
700 b_setval('$translation_stream',In),
701 append_buffer_codes(In,Codes),!,
702 phrase_from_buffer_codes(Grammar,In).
703
704phrase_from_stream_nd(Grammar, In) :- stream_property(In,file_name(_Name)),!,
705 if_debugging(sreader,show_stream_info(In)),
706 read_stream_to_codes(In,Codes),
707 b_setval('$translation_stream',In),
708 append_buffer_codes(In,Codes),!,
709 phrase_from_buffer_codes(Grammar,In).
710
711
712phrase_from_stream_nd(Grammar, In) :- \+ supports_seek(In),!, phrase_from_pending_stream(Grammar, In).
714phrase_from_stream_nd(Grammar, In) :- supports_seek(In),
715 716 717 character_count(In, FailToPosition),
718 ((phrase_from_stream_lazy_part(Grammar, In) -> true ; (seek(In,FailToPosition,bof,_),!,fail))),!.
719
720
721phrase_from_stream_lazy_part(Grammar, In):-
722 check_pending_buffer_codes(In),
723 seek(In, 0, current, Prev),
724 stream_to_lazy_list(In, List),
725 nb_setval('$translation_line',Prev),!,
726 phrase(Grammar, List, More) ->
727 zalwayz((
728 length(List,Used),!,
729 length(More,UnUsed),!,
730 if_debugging(sreader,wdmsg((Offset is Used - UnUsed + Prev))),
731 bx(zalwayz(Offset is Used - UnUsed + Prev)),
732 733 seek(In,Offset,bof,_NewPos))).
735
736
737peek_pending_codes(In,Codes):- peek_pending_codes0(In,Codes0),!,Codes=Codes0.
738peek_pending_codes0(In,Codes):- (t_l:'$fake_buffer_codes'(In,DCodes);Codes=[]),!,clean_fromt_ws(DCodes,Codes).
739
740check_pending_buffer_codes(In):- peek_pending_codes(In,Codes),
741 (Codes==[]->true;(throw(remove_pending_buffer_codes(In,Codes)))),!.
742
743clear_pending_buffer_codes:- forall(retract(t_l:'$fake_buffer_codes'(_In,_DCodes)),true).
744remove_pending_buffer_codes(In,Codes):- retract(t_l:'$fake_buffer_codes'(In,DCodes)),!,clean_fromt_ws(DCodes,Codes).
745remove_pending_buffer_codes(_In,[]). 746
747append_buffer_codes(In,Codes):- retract(t_l:'$fake_buffer_codes'(In,CodesPrev)),!,append(CodesPrev,Codes,NewCodes),assertz(t_l:'$fake_buffer_codes'(In,NewCodes)),!.
748append_buffer_codes(In,Codes):- assertz(t_l:'$fake_buffer_codes'(In,Codes)),!.
749
750wait_on_input(In):- stream_property(In,end_of_stream(Not)),Not\==not,!.
751wait_on_input(In):- repeat,wait_for_input([In],List,1.0),List==[In],!.
752
753read_codes_from_pending_input(In,Codes):- \+ is_stream(In),!,remove_pending_buffer_codes(In,Codes).
754read_codes_from_pending_input(In,Codes):- stream_property(In,end_of_stream(Not)),Not\==not,!,(Not==at->Codes=end_of_file;Codes=[-1]).
755read_codes_from_pending_input(In,Codes):- stream_property(In, buffer(none)),!,
756 repeat,
757 once((wait_on_input(In),
758 read_pending_codes(In,Codes,[]))),
759 (Codes==[] -> (sleep(0.01),fail); true),!.
760read_codes_from_pending_input(In,[Code|Codes]):- get_code(In,Code),read_pending_codes(In,Codes,[]),!.
761throw_reader_error(Error):- wdmsg(throw(reader_error(Error))),dumpST,wdmsg(throw(reader_error(Error))),throw(reader_error(Error)).
762
763supports_seek(In):- notrace_catch_fail(stream_property(In,reposition(true))).
765
766phrase_from_eof(Grammar, _):- var(Grammar),!,unify_next_or_eof(Grammar),!.
768phrase_from_eof(Grammar, _):- term_variables(Grammar,[TV|_]),unify_next_or_eof(TV),!.
769phrase_from_eof(Grammar, In):- throw(end_of_stream_signal(Grammar,In)).
770
771unify_next_or_eof(O) :- clause(t_l:'$last_comment'(I),_,Ref),!,I=O,erase(Ref).
772unify_next_or_eof(end_of_file).
779parse_meta_ascii(Pred, S, Expr) :- is_stream(S),!,parse_meta_stream(Pred, S,Expr).
781parse_meta_ascii(Pred, Text, Expr):-
782 quietly_pfs(txt_to_codes(Text,Codes)),
783 =(ascii_,In),
784 append_buffer_codes(In,[10]),
785 append_buffer_codes(In,Codes),!,
786 phrase_from_buffer_codes_nd(file_meta_with_comments(Pred,Expr), In).
787
788phrase_from_buffer_codes_nd(Grammar, In) :- peek_pending_codes(In,Pend),is_eof_codes(Pend),!,phrase_from_eof(Grammar,In).
789phrase_from_buffer_codes_nd(Grammar, In) :-
790 repeat,
791 (phrase_from_buffer_codes(Grammar, In) *->
792 ((peek_pending_codes(In,Pend),is_eof_codes(Pend))->!;true);(!,fail)).
793
795phrase_from_buffer_codes(Grammar, In):-
796 quietly_pfs((remove_pending_buffer_codes(In,NewCodes), NewCodes \== [])),!,
797 (must_or_rtrace(phrase(Grammar, NewCodes, More))->append_buffer_codes(In,More);(append_buffer_codes(In,NewCodes),!,fail)).
798
799
800skipping_buffer_codes(Goal):-
801 setup_call_cleanup(
802 quietly_pfs((remove_pending_buffer_codes(In,OldCodes), clear_pending_buffer_codes)),
803 Goal,
804 quietly_pfs((clear_pending_buffer_codes,append_buffer_codes(In,OldCodes)))).
805
806is_eof_codes(Codes):- var(Codes),!,fail.
807is_eof_codes(Codes):- Codes == [],!.
808is_eof_codes(Codes):- Codes = [Code],!,is_eof_codes(Code).
809is_eof_codes(end_of_file).
810is_eof_codes(-1).
811
812file_eof(I,O):- notrace(file_eof0(I,O)).
813file_eof0(I,O):- I==end_of_file,!,O=[].
814file_eof0 --> [X],{ X = -1},!.
815file_eof0 --> [X],{ X = 0},!.
816file_eof0 --> [X],{ X = end_of_file},!.
817
818expr_with_text(Out,DCG,O,S,E):-
819 zalwayz(lazy_list_character_count(StartPos,S,M)), 820 call(DCG,M,ME),
821 lazy_list_character_count(EndPos,ME,E),!,
822 expr_with_text2(Out,DCG,O,StartPos,M,ME,EndPos,S,E).
823
824expr_with_text2(Out,_ ,O,StartPos,M,ME,EndPos,_,_):-
825 integer(StartPos),integer(EndPos),!,
826 bx(Len is EndPos - StartPos),l_length(Grabber,Len),!,
827 get_some_with_comments(O,Grabber,Out,M,ME),!.
828expr_with_text2(Out,_ ,O,end_of_file-StartPos,M,ME,end_of_file-EndPos,_,_):-
829 integer(StartPos),integer(EndPos),!,
830 bx(Len is StartPos - EndPos),l_length(Grabber,Len),!,
831 get_some_with_comments(O,Grabber,Out,M,ME),!.
832
833expr_with_text2(Out,DCG,O,StartPos,M,ME,EndPos,S,E):-
834 writeq(expr_with_text2(Out,DCG,O,StartPos,EndPos,S,E)),nl,
835 get_some_with_comments(O,_Grabber,Out,M,ME),!.
836
837
(O,_,O,_,_):- compound(O),compound_name_arity(O,'$COMMENT',_),!.
841get_some_with_comments(O,Txt,with_text(O,Str),S,_E):-append(Txt,_,S),!,text_to_string(Txt,Str).
842
843
844dcg_peek_meta(Grammar,List,List):- (var(Grammar)->((N=2;N=1;between(3,20,N)),l_length(Grammar,N)); true),phrase(Grammar,List,_),!.
845
846
847
848
849eoln --> [C],!, {nonvar(C),charvar(C),eoln(C)},!.
850eoln(10).
851eoln(13).
852eoln --> \+ dcg_peek_meta([_]).
853
854:- meta_predicate(parse_meta_term(2,+,-)). 855
856parse_meta_term(Pred, S, Expr) :- is_stream(S),!, parse_meta_stream(Pred, S,Expr).
857parse_meta_term(Pred, string(String), Expr) :- !,parse_meta_ascii(Pred, String, Expr).
858parse_meta_term(Pred, atom(String), Expr) :- !,parse_meta_ascii(Pred, String, Expr).
859parse_meta_term(Pred, text(String), Expr) :- !,parse_meta_ascii(Pred, String, Expr).
860parse_meta_term(Pred, (String), Expr) :- string(String),!,parse_meta_ascii(Pred, String, Expr).
861parse_meta_term(Pred, [E|List], Expr) :- !, parse_meta_ascii(Pred, [E|List], Expr).
862parse_meta_term(Pred, Other, Expr) :-
863 quietly((l_open_input(Other,In)->Other\=@=In)),!,
864 repeat, (at_end_of_stream(In)->(!,fail);true),
865 parse_meta_term(Pred, In, Expr).
866
867
868quoted_string(Text) --> (double_quoted_string(Text); single_quoted_string(Text)),!.
869
870double_quoted_string(Text) --> `"`, !, zalwayz(s_string_cont(`"`,Text)),!.
871single_quoted_string(Text) --> `'`, !, zalwayz(s_string_cont(`'`,Text)),!.
872single_quoted_string(Text) --> ````, !, zalwayz(s_string_cont((````;`'`),Text)),!.
873
874s_string_cont(End,"") --> End,!.
875s_string_cont(End,Txt) --> read_string_until(S,End), {text_to_string_safe(S,Txt)}.
876
877dcg_used_chars(DCG1, O, S, E):- phrase(DCG1,S, E),!,O=S.
878
879:- fixup_exports.
Utility LOGICMOO_DCG_META
This module allows DCGs to use meta predicates like And Or Not.