17
26:- module(ec_reader,[convert_e/1, set_ec_option/2, verbatum_functor/1, builtin_pred/1, e_to_pl/3]).
27
28
29
30:- use_module(library(logicmoo/portray_vars)). 31
32
33set_ec_option(N,V):- retractall(etmp:ec_option(N,_)),asserta(etmp:ec_option(N,V)).
34
35
37verbatum_functor(function). verbatum_functor(event).
38verbatum_functor(predicate). verbatum_functor(fluent).
39
40
41non_list_functor(ignore).
42non_list_functor(manualrelease).
43non_list_functor(sort).
44non_list_functor(reified_sort).
45non_list_functor(reified).
46non_list_functor(noninertial).
47non_list_functor(mutex).
48non_list_functor(completion).
49is_non_sort(range).
50is_non_sort(option).
51is_non_sort(load).
52is_non_sort(xor).
53is_non_sort(P):- verbatum_functor(P).
54is_non_sort(NoListF):- non_list_functor(NoListF).
55
56builtin_pred(initiates).
57builtin_pred(terminates).
58builtin_pred(releases).
59builtin_pred(holds_at).
60builtin_pred(happens).
61builtin_pred(declipped).
62builtin_pred(clipped).
63builtin_pred(before).
64builtin_pred(after).
65builtin_pred(sort).
66builtin_pred(initially).
67
68is_quantifier_type(thereExists,( & )):- use_some.
69is_quantifier_type(forAll,all).
70is_quantifier_type(thereExists,exists).
71is_quantifier_type(X,Y):- atom(X), is_quantifier_type(_,X),Y=X.
72
74
75:- meta_predicate e_to_pl(1,+,+), e_to_pl(1,+,+). 76:- meta_predicate map_callables(2,*,*). 77:- meta_predicate in_space_cmt(0). 78:- meta_predicate process_e_stream(1,*). 79:- meta_predicate ec_on_read(1,*). 80:- meta_predicate e_io(1,*). 81:- meta_predicate upcased_functors(0). 82:- meta_predicate read_stream_until_true(*,*,1,*). 83:- meta_predicate process_e_stream_token(1,*,*). 84:- meta_predicate continue_process_e_stream_too(1,*,*,*). 85:- meta_predicate process_e_token_with_string(1,*,*). 86:- meta_predicate continue_process_e_stream(1,*,*,*). 87
88:- thread_local(t_l:each_file_term/1). 89:- thread_local(t_l:block_comment_mode/1). 90:- thread_local(t_l:echo_mode/1). 91
95
96:- meta_predicate
97 with_e_sample_tests(1),
98 raise_translation_event(1,*,*). 99
100:- use_module(library(logicmoo_common)).
102
103:- export(e_reader_test/0). 104e_reader_test:- with_e_sample_tests(convert_e(user_output)).
105
106:- export(e_reader_testf/0). 107e_reader_testf:- with_e_sample_tests(convert_e(outdir('.', pro))).
108
109
110
111:- export(with_e_sample_tests/1). 112with_e_sample_tests(Out) :-
113 retractall(etmp:ec_option(load(_), _)),
116 117 118 119 120 121 122 call(Out, ['*/*/*/*.e','*/*/*.e','*/*.e']),
123
125 !.
127
128
131
132raise_translation_event(Why,What,OutputName):- call(Why,translate(What,OutputName)).
133
134
135dedupe_files(SL0,SL):- maplist(relative_file_name,SL0,SL1), list_to_set(SL1,SL).
136 relative_file_name(A,S):- prolog_canonical_source(A,L), file_name_on_path(L,S), atom(S), \+ name(S,[]), !.
137 relative_file_name(A,A).
138
139exists_all_filenames(S0, SL, Options):-
140 findall(N, (relative_from(D),
141 absolute_file_name(S0, N,
142 [relative_to(D), file_type(txt), file_errors(fail), access(read), solutions(all)|Options])), SL0),
143 dedupe_files(SL0,SL),!.
144
145:- export(resolve_local_files/2). 146resolve_local_files(S0,SL):- is_list(S0), !, maplist(resolve_local_files,S0,SS), append(SS,SL).
147resolve_local_files(S0,SL):- atom(S0), exists_file(S0), !, SL = [S0].
148resolve_local_files(S0,SL):- atom(S0), expand_file_name(S0,SL), SL = [E|_], exists_file(E), !.
149resolve_local_files(S0,SL):- exists_all_filenames(S0,SL, [expand(false)]), SL \= [].
150resolve_local_files(S0,SL):- exists_all_filenames(S0,SL, [expand(true)]), SL \= [].
151resolve_local_files(S0,SS):- atom(S0), file_base_name(S0,S1), S0\==S1, resolve_local_files(S1,SS).
152
153relative_from(F):- nb_current('$ec_input_file', F).
154relative_from(D):- working_directory(D,D).
155relative_from(F):- stream_property(_,file_name(F)).
156
163
164:- export(needs_resolve_local_files/2). 165needs_resolve_local_files(F, L):- \+ is_stream(F), \+ is_filename(F),
166 resolve_local_files(F, L), !, L \= [], L \= [F].
167
168:- export(calc_where_to/3). 169calc_where_to(outdir(Dir, Ext), InputName, OutputFile):-
170 atomic_list_concat([InputName, '.', Ext], OutputName),
171 make_directory_path(Dir),
172 absolute_file_name(OutputName, OutputFile, [relative_to(Dir)]).
173
174:- set_ec_option(overwrite_translated_files,false). 175
176:- export(should_update/1). 177should_update(OutputName):- \+ exists_file(OutputName), !.
178should_update(_):- etmp:ec_option(overwrite_translated_files,always),!.
179
180:- export(include_e/1). 181include_e(F):- e_to_pl(do_convert_e, current_output, F).
182
183
184:- export(convert_e/1).
185convert_e(F):- convert_e(outdir('.', pro), F).
186:- export(convert_e/2).
187convert_e(Out, F):- e_to_pl(do_convert_e, Out, F).
188
189:- export(is_filename/1). 190is_filename(F):- atom(F), \+ is_stream(F),
191 (exists_file(F);is_absolute_file_name(F)).
192
194
195e_to_pl(Why, Out, F):- compound(Out), Out=outdir(Dir), !, e_to_pl(Why, outdir(Dir, pro), F).
196e_to_pl(Why, Out, F):- nonvar(F), \+ is_stream(F), \+ is_filename(F), needs_resolve_local_files(F, L), !, maplist(e_to_pl(Why, Out), L).
197
199e_to_pl(Why, Out, F):- atom(F), \+ is_stream(F), \+ is_filename(F),
200 expand_file_name(F, L), L\==[], [F]\==L, !, maplist(e_to_pl(Why, Out), L).
201
203e_to_pl(Why, Out, F):- \+ is_stream(F), \+ is_filename(F),
204 findall(N, absolute_file_name(F, N, [file_type(txt), file_errors(fail), expand(false), solutions(all)]), L),
205 L\=[F], !, maplist(e_to_pl(Why, Out), L).
206
208e_to_pl(Why, Outs, Ins):-
209 atomic(Outs), is_stream(Outs),
210 assertion(stream_property(Outs, output)),
211 \+ current_output(Outs), !,
212 with_output_to(Outs,
213 e_to_pl(current_output, Why, Ins)),!.
214
216e_to_pl(Why, outdir(Dir, Ext), F):- is_filename(F), !,
217 calc_where_to(outdir(Dir, Ext), F, OutputName),
218 e_to_pl(Why, OutputName, F).
219
221e_to_pl(Why, outdir(Dir, Ext), Ins):- must(is_stream(Ins)), !,
222 must(stream_property(Ins, file(InputName))),
223 calc_where_to(outdir(Dir, Ext), InputName, OutputName),
224 e_to_pl(Why, OutputName, Ins).
225
227e_to_pl(Why, OutputName, _Ins):- is_filename(OutputName),
228 \+ should_update(OutputName),
229 raise_translation_event(Why,skipped,OutputName),
230 raise_translation_event(Why,ready,OutputName), !.
231
232e_to_pl(Why, Out, F):- is_filename(F), !,
233 locally(b_setval('$ec_input_file',F),
234 setup_call_cleanup(
235 open(F, read, Ins),
236 e_to_pl(Why, Out, Ins),
237 close(Ins))),!.
238
240e_to_pl(Why, OutputName, Ins):- \+ is_stream(OutputName), !,
241 assertion(is_stream(Ins)), assertion(stream_property(Ins, input)),
242 must(should_update(OutputName)),
243 raise_translation_event(Why,unskipped,OutputName),
244 setup_call_cleanup(
245 open(OutputName, write, Outs),
246 with_output_to(Outs,
247 (raise_translation_event(Why,begining,OutputName),
248 format(Outs,'~N~q.~n',[:- expects_dialect(ecalc)]),
249 e_to_pl(Why, current_output, Ins),
250 raise_translation_event(Why,ending,OutputName))),
251 close(Outs)),
252 raise_translation_event(Why,ready,OutputName).
253
254e_to_pl(Why, Out, Ins):-
255 assertion(current_output(Out)),
256 e_io(Why, Ins).
257
258:- nb_setval(ec_input_file,[]). 259
261e_io(Why, Ins):-
262 repeat,
263 once(process_e_stream(Why, Ins)),
264 notrace(at_end_of_stream(Ins)), !.
265
266
267
268removed_one_ws(S):-
269 peek_code(S, W), char_type(W, white), get_code(S, W), echo_format('~s', [[W]]).
270
271removed_n_chars(_S, N):- N<1, !.
272removed_n_chars(S, N):- get_code(S, _), Nm1 is N-1, removed_n_chars(S, Nm1).
273
274trim_off_whitepace(S):- repeat, \+ removed_one_ws(S).
275
276
277
278read_n_save_vars(Type, Codes):- read_some_vars(Codes, Vars),
279 asserta(etmp:temp_varnames(Type, Vars)).
280
281read_some_vars(Codes, Vars):-
282 must(e_read3(Codes, VarNames)), !,
283 varnames_as_list(VarNames, Vars).
284
285varnames_as_list({A},[A]):- atom(A),!.
286varnames_as_list({A,B},Vars):- !,varnames_as_list({A},Vars1),varnames_as_list({B},Vars2),append(Vars1,Vars2,Vars).
287varnames_as_list(VarNames,Vars):- assertion(is_list(VarNames)), !, VarNames=Vars.
288
289upcased_functors(G):-
290 notrace((allow_variable_name_as_functor = N,
291 current_prolog_flag(N, Was))), !,
292 setup_call_cleanup(notrace(set_prolog_flag(N, true)),
293 G,
294 notrace(set_prolog_flag(N, Was))).
(S) :- (peek_string(S, 3, W);peek_string(S, 2, W);peek_string(S, 1, W)), clause(process_stream_peeked213(S, W),Body),!,once(Body).
302process_stream_peeked213(S, "#!"):- !, read_line_to_string_echo(S, _).
303process_stream_peeked213(S, ";:-"):- !,
304 ( ( nb_current(last_e_string, axiom)) -> (echo_format('~N~n~n',[]), mention_s_l) ; true),
305 get_char(S, ';'), read_term(S, Term, []),!,
306 portray_clause(Term),nl,
307 nb_setval(last_e_string, axiom).
308
309process_stream_peeked213(S, ";"):- !,
310 ( ( nb_current(last_e_string, axiom)) -> (echo_format('~N~n~n',[]), mention_s_l) ; true),
311 echo_format('%'), read_line_to_string_echo(S, _),!,
312 nb_setval(last_e_string, cmt).
313process_stream_peeked213(S, "["):- !,
314 locally(b_setval(e_echo, nil), read_stream_until(S, [], `]`, Codes)),
315 ( (\+ nb_current(last_e_string, cmt), \+ nb_current(last_e_string, vars) ) -> (echo_format('~N~n~n',[]), mention_s_l) ; true),
316 echo_format('% ~s~N',[Codes]),
317 read_n_save_vars(universal, Codes),
318 nb_setval(last_e_string, vars).
319process_stream_peeked213(S, "{"):- mention_s_l, echo_format('% '), !, read_stream_until(S, [], `}`, Codes), read_n_save_vars(existential, Codes).
320
321
323process_e_stream(Why, S):- notrace(at_end_of_stream(S)), !, mention_s_l, call(Why, end_of_file).
324process_e_stream(_, S) :- removed_one_ws(S), !.
325process_e_stream(_, S):- process_stream_comment(S), !.
326
327process_e_stream(Why, S):-
328 OR = [to_lower('.'), to_lower('('), end_of_line, to_lower('='),to_lower('>'), space, to_lower(':')],
329 locally(b_setval(e_echo, nil),
330 read_stream_until_true(S, [], char_type_inverse(Was, or(OR)), Text)),
331 unpad_codes(Text, Codes),
332 ttyflush,
333 must(continue_process_e_stream(Why, S, Codes, Was)), !.
334process_e_stream(Why, S):- read_line_to_string(S, Comment), echo_format('~N%RROOR: ~w: ~s~n', [Why, Comment]), break.
335
336
338continue_process_e_stream(_Why, _S, [], _):- !.
339continue_process_e_stream(_Why, _S, [], end_of_line):- !.
340continue_process_e_stream(Why, S, NextCodes, CanBe ):- ttyflush,
341 continue_process_e_stream_too(Why, S, NextCodes, CanBe ),!.
342
343continue_process_e_stream_too(Why, _S, Codes, to_lower(':')):-
344 append(Delta, [_], Codes),
345 text_to_string(Delta,DeltaS),
346 normalize_space(atom(Term),DeltaS),
347 nb_setval(last_e_string, delta),
348 echo_format('~N~n'),maybe_mention_s_l(0), echo_format('% ~s ', [Codes]),
349 ec_on_read(Why, directive(Term)),!.
350continue_process_e_stream_too(Why, S, Codes, space):- last(Codes, Last),
351 once([Last]=`!`;char_type(Last, alpha)), !,
352 trim_off_whitepace(S), !,
353 atom_codes(Token, Codes),
354 nb_setval(last_e_string, kw),
355 echo_format('~N~n'),maybe_mention_s_l(1), echo_format('% ~s ', [Codes]),
356 process_e_stream_token(Why, Token, S), ttyflush, !.
357continue_process_e_stream_too(Why, S, NextCodes, _CanBe ):- !,
358 ( \+ nb_current(last_e_string, vars) -> (echo_format('~N~n~n',[]), mention_s_l) ; true),
359 maybe_mention_s_l(2), echo_format('% ~s', [NextCodes]),
360 last(NextCodes, Last), cont_one_e_compound(S, NextCodes, Last, Term), ec_on_read(Why, Term).
361
362unpad_codes(Text, Codes):- text_to_string(Text, String),
363 normalize_space(codes(Codes0), String),
364 trim_eol_comment(Codes0,Codes).
365
(Codes,Left):- append(Left,[59|_Cmt], Codes),!.
367trim_eol_comment(Codes,Codes).
368
369
370e_from_atom(String, Term):- e_read1(String, Term, _).
371
372set_e_ops(M):-
373 op(1150, yfx, M:'->'),
374 op(1150, xfx, M:'->'),
375 op(1150, xfy, M:'->'),
376 377 op(1100, xfy, M:'<->'),
378 op(1075, xfx, M:'thereExists'),
379 op(1050, xfy, M:'|'),
380 op(950, xfy, M:'&'),
381 op(900, fx, M:'!'),
382 op(1,fx,(M:($))).
383
384e_read3(String, Term):-
385 M = ecread,
386 forall(current_op(_,fx,OP),
387 op(0,fx,(M:OP))),
388 set_e_ops(M),
389 upcased_functors(notrace(((catch(
390 (read_term_from_atom(String, Term,
391 [var_prefix(true),variable_names(Vars), module(M)])), _, fail))))), !,
392 maplist(ignore, Vars).
393
394:- dynamic(etmp:temp_varnames/2).
395:- dynamic(etmp:ec_option/2). 396
397
398insert_vars(Term, [], Term, []).
399insert_vars(Term0, [V|LL], Term, [V=VV|Has]):-
400 insert1_var(Term0, V, VV, Term1),
401 insert_vars(Term1, LL, Term, Has).
402
403
404insert1_var(Term0, V, VV, Term1):-
405 debug_var(V, VV),
406 subst(Term0, V, VV, Term1).
407
408
409map_callables(_, Term0, Term):- \+ callable(Term0), !, Term0=Term.
410map_callables(_, Term0, Term):- []== Term0, !, Term =[].
411map_callables(Call, Term0, Term):- atom(Term0), !, call(Call, Term0, Term).
412map_callables(_Call, Term0, Term):- \+ compound(Term0), !, Term0=Term.
413map_callables(Call, Compound=Value, Term):- fail, compound(Compound),
414 append_term(Compound, Value, Term0), map_callables(Call, Term0, Term).
415map_callables(_, '$VAR'(HT), '$VAR'(HT)):-!.
416map_callables(Call, [H|T], [HTerm|TTerm]):- !, map_callables(Call, H, HTerm), map_callables(Call, T, TTerm), !.
417map_callables(Call, '$'(F, A), '$'(FF, AA)):- A==[], [] = AA, !, call(Call, F, FF).
419map_callables(Call, '$'(F, A), '$'(FF, AA)) :- call(Call, F, FF), maplist(map_callables(Call), A, AA), !.
420map_callables(Call, HT, HTTerm):- !,
421 compound_name_arguments(HT, F, L),
422 map_callables(Call, '$'(F, L), '$'(FF, LL)),
423 compound_name_arguments(HTTerm, FF, LL).
424
425:- export(compound_gt/2). 426compound_gt(P,GT):- notrace((compound(P), compound_name_arity(P, _, N), N > GT)).
427
428
429:- export(fix_predname/2). 430
431fix_predname('!', 'not').
432fix_predname('~', 'not').
433
434fix_predname(';', ';').
435fix_predname('\\/', ';').
436fix_predname('v', ';').
437fix_predname('or', ';').
438fix_predname('|', ';').
439fix_predname('xor', 'xor').
440
441fix_predname(',', ',').
442fix_predname('^', ',').
443fix_predname('and', ',').
444fix_predname('&', ',').
445fix_predname('/\\', ',').
446
447fix_predname('equiv','<->').
448fix_predname('iff', '<->').
449fix_predname('<->', '<->').
450fix_predname('<=>', '<->').
451
452fix_predname('->', '->').
453fix_predname('implies', '->').
454fix_predname('=>', '->').
455fix_predname('if', '->').
456
457fix_predname(holds_at, holds_at).
458fix_predname(holdsat, holds_at).
459
460fix_predname(Happens, Happens):- builtin_pred(Happens).
461
462fix_predname(F, New):- downcase_atom(F, DC), F\==DC, !, fix_predname(DC, New).
463
464
465
466
467my_unCamelcase(X, Y):- atom(X), fix_predname(X, Y), !.
468my_unCamelcase(X, Y):- atom(X), upcase_atom(X, X), !, downcase_atom(X, Y).
469my_unCamelcase(X, Y):- unCamelcase(X, Y), !.
470
471:- export(e_to_ec/2). 472e_to_ec(C, C):- \+ callable(C), !.
473e_to_ec('$VAR'(HT), '$VAR'(HT)):-!.
474e_to_ec(X, Y):- \+ compound(X), !, must(my_unCamelcase(X, Y)).
475e_to_ec(X, Y):- compound_name_arity(X, F, 0), !, my_unCamelcase(F, FF), compound_name_arity(Y, FF, 0).
476e_to_ec(not(Term),not(O)):- !, e_to_ec(Term, O).
477e_to_ec(Prop,O):-
478 Prop =.. [ThereExists,NotVars,Term0],
479 is_quantifier_type(ThereExists,_Exists),
480 conjuncts_to_list(NotVars,NotVarsL), select(not(Vars),NotVarsL,Rest),
481 is_list(Vars), 482 (Rest==[]->Term1= Term0 ; list_to_conjuncts(Rest,NotVarsRest),conjoin(NotVarsRest,Term0,Term1)),
483 QProp =.. [ThereExists,Vars,Term1],
484 e_to_ec(not(QProp),O).
485e_to_ec(Prop,O):-
486 Prop =.. [ThereExists,Vars,Term0],
487 is_quantifier_type(ThereExists,Exists),
488 is_list(Vars), forall(member(E,Vars),ground(E)),
489 QProp =.. [Exists,Vars,Term0],
490 insert_vars(QProp, Vars, Term, _Has),
491 e_to_ec(Term,O),!.
492
496e_to_ec(t(X, [Y]), O):- nonvar(Y), !, e_to_ec(t(X, Y), O).
497e_to_ec(load(X), load(X)).
498e_to_ec(include(X), include(X)).
499e_to_ec(option([N, V]), O):- !, e_to_ec(option(N, V), O).
500e_to_ec(range([N, V, H]), O):- !, e_to_ec(range(N, V, H), O).
501
502e_to_ec(t(X, Y), O):- atom(X), is_non_sort(X), !, SS=..[X, Y], e_to_ec(SS, O).
503e_to_ec(t(X, Y), O):- atom(X), is_list(Y), is_non_sort(X), SS=..[X|Y], e_to_ec(SS, O).
504e_to_ec(t(X, Y), O):- atom(X), is_list(Y), SS=..[X, Y], e_to_ec(SS, O).
505e_to_ec(sort(col([S1, S2])), O):- !, e_to_ec(subsort(S1, S2), O).
506e_to_ec(function(F, [M]), O):- e_to_ec(function(F, M), O).
514e_to_ec(HT, HTTermO):- !,
515 compound_name_arguments(HT, F, L),
516 maplist(e_to_ec,L,LL),
517 compound_name_arguments(HTTerm, F, LL),
518 map_callables(my_unCamelcase, HTTerm, HTTermO).
519
520
521vars_verbatum(Term):- \+ compound_gt(Term, 0), !.
522vars_verbatum(Term):- compound_name_arity(Term, F, A), (verbatum_functor(F);verbatum_functor(F/A)), !.
523
524add_ec_vars(Term0, Term, Vs):- vars_verbatum(Term0), !, Term0=Term, Vs=[].
525add_ec_vars(Term0, Term, Vs):-
526 get_vars(universal, UniVars),
527 get_vars(existential,ExtVars),
528 insert_vars(Term0, UniVars, Term1, VsA),!,
529 add_ext_vars(VsA, ExtVars, Term1, Term, Vs), !.
530
531add_ext_vars(Vs, [], Term, Term, Vs):- !.
532add_ext_vars(VsA, LLS, Term0, Term, Vs):- use_some,
533 insert_vars((some(LLS), Term0), LLS, Term, VsB), !,
534 append(VsA,VsB,Vs),!.
535add_ext_vars(VsA, LLS, Term0, Term, Vs):-
536 insert_vars(exists(LLS, Term0), LLS, Term, VsB), !,
537 append(VsA,VsB,Vs),!.
538
539use_some :- fail.
540
541get_vars(Type,LLS):- findall(E, (etmp:temp_varnames(Type,L), member(E, L)), LL), sort(LL, LLS),!.
542
543
544e_read1(String, Term, Vs):-
545 e_read2(String, Term0), !,
546 add_ec_vars(Term0, Term1, Vs), !,
547 retractall(etmp:temp_varnames(_,_)),
548 e_to_ec(Term1, Term), !.
549
550if_string_replace(T, B, A, NewT):-
551 atomics_to_string(List, B, T), List=[_,_|_], !,
552 atomics_to_string(List, A, NewT).
553
554
555e_read2(Txt, Term):- \+ string(Txt), text_to_string(Txt, T),!, e_read2(T, Term).
556e_read2(T, Term):- if_string_replace(T, '!=', (\=), NewT), !, e_read2(NewT, Term).
557e_read2(T, Term):- use_some,
558 if_string_replace(T, '{', ' some( ', T1),
559 if_string_replace(T1, '}', ' ) & ', NewT),
560 e_read2(NewT, Term).
561e_read2(T, Term):-
562 if_string_replace(T, '{', ' [ ', T1),
563 if_string_replace(T1, '}', ' ] thereExists ', NewT),
564 e_read2(NewT, Term).
567e_read2(T, Term):- e_read3(T, Term), !.
568e_read2(T, Term):-
569 must(e_read3(T, Term)), !.
570
571
572
573cleanout(Orig, B, E, MidChunk, RealRemainder):-
574 text_to_string(Orig, Str),
575 AfterFirstB=[_|_],
576 atomic_list_concat([BeforeB|AfterFirstB], B, Str),
577 atomics_to_string( AfterFirstB, B, AfterB),
578 Remainder=[_|_],
579 atomic_list_concat([Mid|Remainder], E, AfterB),
580 atomics_to_string( Remainder, E, AfterE),
581 atomics_to_string( [BeforeB,' ', AfterE], RealRemainder),
582 atomics_to_string( [B, Mid, E], MidChunk).
583
584
585read_one_e_compound(S, Term):-
586 read_stream_until_true(S, [], char_type_inverse(_Was, or([to_lower('.'), end_of_line])), Text),
587 unpad_codes(Text, Codes), last(Codes, Last),
588 cont_one_e_compound(S, Codes, Last, Term).
589
590cont_one_e_compound(_S, Text, Last, Term):- char_type(Last, to_lower('.')),
591 unpad_codes(Text, Codes), e_from_atom(Codes, Term), nb_setval(last_e_string, axiom).
592
593cont_one_e_compound(_S, Text, Last, Term):- char_type(Last, to_lower(')')),
594 \+ (member(T, `>&|`), member(T, Text)),
595 unpad_codes(Text, Codes), e_from_atom(Codes, Term), nb_setval(last_e_string, axiom).
596
597cont_one_e_compound(S, InCodes, WasLast, Term):- process_stream_comment(S), !, cont_one_e_compound(S, InCodes, WasLast, Term).
598cont_one_e_compound(S, InCodes, WasLast, Term):-
599 (WasLast\==40-> echo_format('% ') ; true),
600 read_stream_until_true(S, InCodes, char_type_inverse(_Was, or([to_lower('.'), end_of_line])), Text),
601 unpad_codes(Text, Codes), last(Codes, Last),
602 cont_one_e_compound(S, Codes, Last, Term).
603
604
606
607:- dynamic(last_s_l/2). 608
609:- export(maybe_mention_s_l/1). 610maybe_mention_s_l(N):- last_s_l(B,L),LLL is L+N, s_l(BB,LL), B==BB, !, (LLL<LL -> mention_s_l; true).
611maybe_mention_s_l(_):- mention_s_l.
612
613:- export(mention_s_l/0). 614mention_s_l:-
615 s_l(B,L0),
616 L is L0-1,
617 L2 is L0,
618 absolute_file_name(B,F),
619 real_ansi_format([fg(green)], '~N% From ~w~n', [F:L]),
620 ttyflush,
621 retractall(last_s_l(B,_)),asserta(last_s_l(B,L2)).
622
623:- export(s_l/2). 624s_l(F,L):- source_location(F,L), !.
625s_l(F,L):- any_stream(F,S), any_line_count(S,L),any_line_count(_,L), !.
626s_l(unknown,0).
627
628any_stream(F,S):- stream_property(S, file_name(F)),stream_property(S, input).
629any_stream(F,S):- current_stream(F, read, S), atom(F).
630any_stream(F,S):- stream_property(S, file_name(F)).
631any_stream(F,S):- current_stream(F, _, S), atom(F).
632any_line_count(_,L):- nonvar(L),!.
633any_line_count(S,L):- stream_property(S, line_count(L)).
634any_line_count(S,L):- line_or_char_count(S, L).
635any_line_count(S,L):- stream_property(S, line_or_char_count(L)).
636any_line_count(_,0).
637
639
640:- meta_predicate ec_on_each_read(1,*,*). 641
642ec_on_read(Why, EOF):- EOF == end_of_file, !, must(call(Why, EOF)).
643ec_on_read(Why, SL):- e_to_ec(SL, SO) -> SL\=@=SO, !, ec_on_read(Why, SO).
644ec_on_read(Why, Cmp):- compound_gt(Cmp, 0),
645 Cmp =.. [NonlistF, List], is_list(List), non_list_functor(NonlistF),!,
646 maplist(ec_on_each_read(Why,NonlistF), List).
647ec_on_read(Why, S):- must(glean_data(Why, S)), must(call(Why, S)).
648
649
650:- use_module(library(logicmoo/misc_terms)). 651
652ec_on_each_read(Why, NonlistF, E):- Cmp univ_safe [NonlistF, E], ec_on_read(Why, Cmp).
653
656
657on_convert_ele(translate(Event, Outfile)):- !, must((mention_s_l, echo_format('~N% translate: ~w File: ~w ~n',[Event, Outfile]))).
658on_convert_ele(include(S0)):- resolve_local_files(S0,SS), !, maplist(include_e, SS), !.
660on_convert_ele(end_of_file).
661on_convert_ele(SS):- must(echo_format('~N')), must(pprint_ecp(e,SS)).
662
663
664do_convert_e(SS):- on_convert_ele(SS).
665
666:- meta_predicate with_op_cleanup(*,*,*,0). 667
668
669str_repl(F,R,I,O):- if_string_replace(I,F,R,O),!.
670str_repl(_,_,I,I).
671replcterm(F,R,I,O):- subst(I,F,R,O),!.
672
673
674get_operators(P,[]):- \+ compound_gt(P, 0), !.
675get_operators([H|T],Ops):- !, get_operators(H,L),get_operators(T,R),append(L,R,Ops).
676get_operators(P,Ops):- P=..[F|List],get_operators(List,More),
677 (is_operator(F)->Ops=[F|More];Ops=More).
678
679is_operator('<->').
680is_operator('->').
681is_operator('-->').
682is_operator('<-').
683is_operator(F):- current_op(N,_,F),N>800.
684
685mid_pipe(In,[H|T],Out):- !,mid_pipe(In,H,Mid),mid_pipe(Mid,T,Out).
686mid_pipe(In,[],In):-!.
687mid_pipe(In,H,Out):- !, call(H,In,Out).
688
689
690
691trim_stop(S,O):- sub_string(S, N, 1, 0, Last),
692 (Last = "." -> sub_string(S, 0, N, 1, O);
693 ((Last="\n";Last="\r";Last=" ") -> (sub_string(S, 0, N, 1, Before),trim_stop(Before,O)) ; S=O)).
694
695clause_to_string(T,S):-
696 with_output_to(string(S0),
697 prolog_listing:portray_clause(current_output,T,
698 [portrayed(false),partial(true),nl(false),fullstop(false),singletons(false)])),!,
699 trim_stop(S0,S).
700
701print_e_to_string_b(H, S):-
702 compound_gt(H, 0), H=..[F,_,_],
703 current_op(_,_,F),
704 print_e_to_string(H, S0),
705 mid_pipe(S0,[str_repl('\n',' \n')],S1),
706 sformat(S, '(~s)',[S1]),!.
707
708print_e_to_string_b(H, HS):- print_e_to_string(H, HS),!.
709
710print_e_to_string(T, Ops, S):- member(':-', Ops), !, clause_to_string(T,S).
711print_e_to_string(T, Ops, S):- member('-->', Ops), !, clause_to_string(T,S).
712
713print_e_to_string(T, Ops, S):- member('<-', Ops), !,
714 subst(T,('<-'),(':-'),T0),
715 clause_to_string(T0,S0), !,
716 mid_pipe(S0,str_repl(':-','<-'),S).
717
718print_e_to_string(exists(Vars,H), _, S):-
719 print_e_to_string(H, HS),
720 sformat(S, 'exists(~p,\n ~s)',[Vars, HS]).
721
722print_e_to_string(T, Ops, S):- Ops \== [],
723 member(EQUIV-IF,[('->'-'<->'),(if-equiv)]),
724 (member(IF, Ops);member(EQUIV, Ops)),
725
726 mid_pipe(T, [replcterm((EQUIV),(':-')), replcterm((IF),('-->'))],T0),
727 clause_to_string(T0,S0),!,
728 mid_pipe(S0, [str_repl(':-',EQUIV),str_repl('-->',IF)],S).
729
730
731print_e_to_string(T, Ops, S):- member('<->', Ops), sformat(S0, '~p',[T]),
732 mid_pipe(S0,str_repl('<->','<->\n '),S).
733
737print_e_to_string(axiom(H,B), _, S):-
738 print_e_to_string((H-->B), S0),
739 mid_pipe(S0,[str_repl(' \n','\n'),str_repl(' -->',','),str_repl('\n\n','\n')],S1),
740 sformat(S,'axiom(~s)',[S1]).
741
742print_e_to_string(B, [Op|_], S):- ((Op== ';') ; Op==','), !,
743 print_e_to_string((:- B), S0),
744 mid_pipe(S0,[str_repl(':-','')],S).
745
746print_e_to_string(B, _, S):- is_list(B), !,
747 print_e_to_string((:- B), S0),
748 mid_pipe(S0,[str_repl(':-','')],S).
749
750print_e_to_string(T, _Ops, S):- is_list(T), print_et_to_string(T,S,[right_margin(80)]),!.
751print_e_to_string(T, _Ops, S):- must(print_et_to_string(T,S,[])).
752
753print_et_to_string(T,S,Options):-
754 ttyflush,
755 sformat(S, '~@',
756 [(prolog_pretty_print:print_term(T,
757 [ 758 write_options([numbervars(true),
759 quoted(true),
760 portray(true)]),
761 762 763 output(current_output)|Options]),
764 ttyflush)]).
765
766
767to_ansi(e,[bold,fg(yellow)]).
768to_ansi(ec,[bold,fg(green)]).
769to_ansi(pl,[bold,fg(cyan)]).
770to_ansi([H|T],[H|T]).
771to_ansi(C, [bold,hfg(C)]):- assertion(nonvar(C)), is_color(C),!.
772to_ansi(H,[H]).
773
774is_color(white). is_color(black). is_color(yellow). is_color(cyan).
775is_color(blue). is_color(red). is_color(green). is_color(magenta).
776
777
778is_output_lang(Lang):- atom(Lang), Lang \==[],
779 \+ is_color(Lang), nb_current('$output_lang',E),E\==[], !, memberchk(Lang,E).
780is_output_lang(_).
781
784
785:- export(pprint_ecp_cmt/2). 786pprint_ecp_cmt(C, P):-
787 echo_format('~N'),
788 print_e_to_string(P, S0),
789 into_space_cmt(S0,S),
790 to_ansi(C, C0),
791 real_ansi_format(C0, '~s', [S]).
792
793:- export(pprint_ecp/2). 794pprint_ecp(C, P):- \+ is_output_lang(C), !, pprint_ecp_cmt(C, P).
795pprint_ecp(C, P):-
796 maybe_mention_s_l(0),
797 echo_format('~N'),
798 pprint_ec_and_f(C, P, '.~n').
799
800pprint_ec_and_f(C, P, AndF):-
801 maybe_mention_s_l(1),
802 pprint_ec_no_newline(C, P),
803 echo_format(AndF), !,
804 ttyflush.
805
806user:portray(Term):- \+ current_prolog_flag(debug,true), \+ tracing, ec_portray_hook(Term).
807
808ec_portray_hook(Term):-
809 setup_call_cleanup(flag('$ec_portray', N, N+1),
810 ec_portray(N, Term),
811 flag(ec_portray,_, N)).
812
813ec_portray(_,Var):- var(Var),!,fail. 814ec_portray(_,'$VAR'(Atomic)):- atom(Atomic), name(Atomic,[C|_]), !,
815 (code_type(C,prolog_var_start)->write(Atomic);writeq('$VAR'(Atomic))).
816ec_portray(_,Term):- notrace(is_list(Term)),!,Term\==[], fail, notrace(catch(text_to_string(Term,Str),_,fail)),!,format('"~s"',[Str]).
817ec_portray(_,Term):- compound(Term),compound_name_arity(Term, F, 0), !,ansi_format([bold,hfg(red)],'~q()',[F]),!.
818ec_portray(N,Term):- N < 2,
819 820 ttyflush,
821 catch(pprint_ec_no_newline(white, Term),_,fail),!.
822
823
824pprint_ec_no_newline(C, P):-
825 print_e_to_string(P, S),
826 to_ansi(C, C0),
827 real_ansi_format(C0, '~s', [S]).
828
829
830print_e_to_string(P, S):-
831 get_operators(P, Ops),
832 pretty_numbervars(P, T),
833 print_e_to_string(T, Ops, S).
844
845get_op_restore(OP,Restore):-
846 findall(op(E,YF,OP),(member(YF,[xfx,xfy,yfx,fy,fx,xf,yf]),current_op(E,YF,OP)),List),
847 Restore = maplist(call,List).
848get_op_zero(OP,Zero):-
849 findall(op(0,YF,OP),(member(YF,[xfx,xfy,yfx,fy,fx,xf,yf])),List),
850 Zero = maplist(call,List).
851
852with_op_cleanup(_NewP,_YF,_OP,Goal):- !, Goal.
853with_op_cleanup(NewP,YF,OP,Goal):-
854 (current_op(OldP,YF,OP);OldP=0) ->
855 get_op_restore(OP,Restore),
856 get_op_zero(OP,Zero),
857 Setup = (Zero,op(NewP,YF,OP)),
858 Cleanup = (op(OldP,YF,OP),Restore),
859 scce_orig(Setup,Goal,Cleanup).
860
861glean_data(Why, SL):- \+ compound(SL), !, dmsg(warn(glean_data(Why, SL))).
862glean_data(Why, subsort(S1, S2)):- !, glean_data(Why, sort(S1)), glean_data(Why, sort(S2)), assert_gleaned(Why, subsort(S1, S2)).
863glean_data(Why, sort(S)):- !, assert_gleaned(Why, sort(S)).
864glean_data(Why, isa(E, S)):- !, assert_gleaned(Why, isa(E, S)).
865glean_data(Why, SL):- SL=..[S, L],
866 \+ is_non_sort(S), is_list(L), !,
867 glean_data(Why, sort(S)),
868 maplist(glean_data(Why, hasInstance(S)), L).
869glean_data(_, _).
870
872assert_gleaned(_Why, SS):- asserta_if_new(gleaned(SS)).
874
875glean_data(Why, hasInstance(S), E):- !, glean_data(Why, isa(E, S)).
876
877
878
879process_e_stream_token(Why, Atom, S):- atom_concat(New, '!', Atom), !, process_e_stream_token(Why, New, S).
880process_e_stream_token(Why, Type, S):- normalize_space(atom(A), Type), A\==Type, !, process_e_stream_token(Why, A, S).
881process_e_stream_token(Why, Text, S):- \+ atom(Text), !, text_to_string(Text, String), atom_string(Atom,String), process_e_stream_token(Why, Atom, S).
882process_e_stream_token(Why, function, S):- !, read_stream_until(S, [], `:`, Text), read_line_to_string_echo(S, String),
883 append(TextL, [_], Text),
884 e_read1(TextL, Value, _),
885 token_stringsss(String, Type),
886 ec_on_read(Why, (function(Value, Type))).
887
888process_e_stream_token(Why, Type, S):- downcase_atom(Type, Event), memberchk(Event, [fluent, predicate, event]), !,
889 read_one_e_compound(S, Value), ec_on_read(Why, t(Event, Value)).
890process_e_stream_token(Why, reified, S):- !, read_stream_until(S, [], ` `, Text),
891 text_to_string(Text, St), atom_concat('reified_', St, Type), !, process_e_stream_token(Why, Type, S).
892process_e_stream_token(Why, Type, S):- read_line_to_string_echo(S, String), process_e_token_with_string(Why, Type, String).
893
894process_e_token_with_string(Why, Type, String):- \+ is_non_sort(Type), atomics_to_string(VList, ',', String), VList \= [_], !,
895 maplist(process_e_token_with_string(Why, Type), VList).
896process_e_token_with_string(_, _, ""):-!.
897process_e_token_with_string(Why, Type, String):- token_stringsss(String, Out), ec_on_read(Why, t(Type, Out)).
898
899token_stringsss("", []):-!.
900token_stringsss(T, Out) :- if_string_replace(T, ' ', ' ', NewT), !, token_stringsss(NewT, Out).
901token_stringsss(T, Out) :- if_string_replace(T, ': ', ':', NewT), !, token_stringsss(NewT, Out).
902token_stringsss(T, Out) :- if_string_replace(T, ' :', ':', NewT), !, token_stringsss(NewT, Out).
903token_stringsss(String, Out):- normalize_space(string(S), String), S\==String, !, token_stringsss(S, Out).
904token_stringsss(String, VVList):- atomics_to_string(VList, ',', String), VList \= [_], remove_blanks_col(VList, VVList), !.
905token_stringsss(String, col(VVList)):- atomics_to_string(VList, ':', String), VList \= [_], remove_blanks(VList, VVList), !.
906token_stringsss(String, VVList):- atomics_to_string(VList, ' ', String), remove_blanks(VList, VVList), !.
907
908remove_blanks_col(I, O):- remove_blanks(I, M),maplist(token_cols, M, O).
909
910token_cols(String, col(VVList)):- atomics_to_string(VList, ':', String), VList \= [_], remove_blanks(VList, VVList), !.
911token_cols(String,String).
912
913remove_blanks([], []).
914remove_blanks([''|I], O):- !, remove_blanks(I, O).
915remove_blanks([E|I], O):- string(E), normalize_space(string(EE), E), E\==EE, !, remove_blanks([EE|I], O).
916remove_blanks([E|I], O):- atom(E), normalize_space(atom(EE), E), E\==EE, !, remove_blanks([EE|I], O).
917remove_blanks([E|I], O):- to_atomic_value(E, EE), E\==EE, !, remove_blanks([EE|I], O).
918remove_blanks([E|I], [E|O]):- remove_blanks(I, O).
919
920
921to_atomic_value(A, N):- number(A), !, N=A.
922to_atomic_value(A, N):- normalize_space(atom(S), A), S\==A, !, to_atomic_value(S, N).
923to_atomic_value(A, N):- atom_number(A, N).
924to_atomic_value(A, A).
925
926:- meta_predicate(read_stream_until(+,+,*,-)). 927read_stream_until(S, Buffer, [Until], Codes):- !, name(N, [Until]), char_code(N, UntilCode), !,
928 read_stream_until_true(S, Buffer, ==(UntilCode), Codes).
929read_stream_until(S, Buffer, UntilCode, Codes):- integer(UntilCode), !,
930 read_stream_until_true(S, Buffer, ==(UntilCode), Codes).
931read_stream_until(S, Buffer, Until, Codes):- atom(Until), atom_length(Until, 1), char_code(Until, UntilCode), !,
932 read_stream_until_true(S, Buffer, ==(UntilCode), Codes).
933read_stream_until(S, Buffer, Until, Codes):- read_stream_until_true(S, Buffer, Until, Codes).
934
935char_type_inverse(Type, or(TypeList), Code):- !, member(E, TypeList), char_type_inverse(Type, E, Code).
936char_type_inverse(Type, [Spec], Code):- !, char_type_inverse(Type, Spec, Code).
937char_type_inverse(Type, [Spec|List], Code):- !, char_type_inverse(_, Spec, Code), char_type_inverse(Type, List, Code).
938char_type_inverse(Type, Spec, Code):- char_type(Code, Spec), Type=Spec.
939
940read_stream_until_true(S, Buffer, Pred, Buffer):- at_end_of_stream(S), !, ignore(call(Pred, 10)).
941read_stream_until_true(S, Buffer, Pred, Codes):- get_code(S, Char),
942 (nb_current(e_echo,nil) -> true; put_out(Char)),
943 (call(Pred, Char) -> notrace(append(Buffer, [Char], Codes)) ;
944 (notrace(append(Buffer, [Char], NextBuffer)), read_stream_until_true(S, NextBuffer, Pred, Codes))).
945
946
947into_space_cmt(S0,O):-
948 949 str_repl('\n','\n ',S0, S),
950 (S0==S -> sformat(O, '~N % ~s.~n', [S]);
951 sformat(O, '~n /* ~s.~n */~n', [S])).
952
955in_space_cmt(Goal):-
956 with_output_to(string(S0),Goal),
957 into_space_cmt(S0,S),
958 real_format('~s', [S]).
959
960in_space_cmt(Goal):- setup_call_cleanup(echo_format('~N /* ', []), Goal, echo_format('~N */~n', [])).
961
962
963read_line_to_string_echo(S, String):- read_line_to_string(S, String), ttyflush, real_ansi_format([bold, hfg(black)], '~s~N',[String]),
964 ttyflush.
965
966echo_flush:- ttyflush.
967:- export(echo_format/1). 968echo_format(S):- echo_flush, echo_format(S, []).
969:- export(echo_format/2). 970echo_format(_Fmt, _Args):- t_l:block_comment_mode(Was), Was==invisible, !.
971echo_format(Fmt, Args):- t_l:block_comment_mode(_), t_l:echo_mode(echo_file), !, real_format(Fmt, Args), ttyflush.
972echo_format(Fmt, Args):- t_l:echo_mode(echo_file), !, real_format(Fmt, Args), ttyflush.
973echo_format(_Fmt, _Args):- t_l:echo_mode(skip(_)), !.
974echo_format(Fmt, Args):- real_format(Fmt, Args), ttyflush, !.
976
977is_outputing_to_file:-
978 current_output(S),
979 stream_property(S,file_name(_)).
980
981put_out(Char):- put(Char),
982 (is_outputing_to_file-> put(user_error,Char);true).
983
984real_format(Fmt, Args):-
985 (is_outputing_to_file -> with_output_to(user_error, (ansi_format([hfg(magenta)], Fmt, Args),ttyflush)) ; true),
986 format(Fmt, Args),!,ttyflush.
987
988
989real_ansi_format(Ansi, Fmt, Args) :-
990 (is_outputing_to_file -> format(Fmt, Args) ; true),
991 with_output_to(user_error,(ansi_format(Ansi, Fmt, Args),ttyflush)).
992
993
1010
1011
1012
1013till_eof(In) :-
1014 repeat,
1015 ( at_end_of_stream(In)
1016 -> !
1017 ; (read_pending_codes(In, Chars, []),
1018 (t_l:echo_mode(echo_file) ->
1019 echo_format('~s', [Chars]);
1020 true),
1021 fail)
1022 )