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