17
26:- module(ec_reader,[convert_e/1, set_ec_option/2, verbatum_functor/1, builtin_pred/1, s_l/2,
27 with_e_file/3,
28 convert_e/2,
29 echo_format/1,
30 e_reader_test/0,
31 e_reader_test/1,
32 e_reader_testf/0,
33 e_reader_testf/1,
34 echo_format/2]).
35
36
37
38:- use_module(library(logicmoo/portray_vars)). 39
40
41set_ec_option(N,V):- retractall(etmp:ec_option(N,_)),asserta(etmp:ec_option(N,V)).
42
43
45verbatum_functor(function). verbatum_functor(event).
46verbatum_functor(predicate). verbatum_functor(fluent).
47verbatum_functor(next_axiom_uses).
48
49is_reified_sort(S):- S==belief.
50
51non_list_functor(P):- pel_directive(P).
52non_list_functor(sort).
53non_list_functor(next_axiom_uses).
54non_list_functor(reified_sort).
55
56pel_directive(ignore).
57pel_directive(manualrelease).
59pel_directive(reified).
60pel_directive(noninertial).
61pel_directive(mutex).
62pel_directive(completion).
63
64pel_directive(range).
65pel_directive(option).
66pel_directive(load).
67pel_directive(include).
68is_non_sort(xor).
69
70is_non_sort(P):- pel_directive(P).
71is_non_sort(P):- verbatum_functor(P).
72is_non_sort(NoListF):- non_list_functor(NoListF).
73
74builtin_pred(initiates).
75builtin_pred(terminates).
76builtin_pred(releases).
77builtin_pred(holds_at).
78builtin_pred(happens).
79builtin_pred(declipped).
80builtin_pred(clipped).
81builtin_pred(b).
82builtin_pred(before).
83builtin_pred(after).
84builtin_pred(sort).
85builtin_pred(initially).
86
87is_quantifier_type(thereExists,( & )):- use_some.
88is_quantifier_type(forAll,all).
89is_quantifier_type(thereExists,exists).
90is_quantifier_type(X,Y):- atom(X), is_quantifier_type(_,X),Y=X.
91
93
94:- meta_predicate with_e_file(1,+,+), with_e_file(1,+,+). 95:- meta_predicate map_callables(2,*,*). 96:- meta_predicate process_e_stream(1,*). 97:- meta_predicate ec_on_read(1,*). 98:- meta_predicate e_io(1,*). 99:- meta_predicate upcased_functors(0). 100:- meta_predicate read_stream_until_true(*,*,1,*). 101:- meta_predicate process_e_stream_token(1,*,*). 102:- meta_predicate continue_process_e_stream_too(1,*,*,*). 103:- meta_predicate process_e_token_with_string(1,*,*). 104:- meta_predicate continue_process_e_stream(1,*,*,*). 105
106:- thread_local(t_l:each_file_term/1). 107:- thread_local(t_l:block_comment_mode/1). 108:- thread_local(t_l:echo_mode/1). 109
113
114:- meta_predicate
115 with_e_sample_tests(1),
116 raise_translation_event(1,*,*). 117
118:- use_module(library(logicmoo_common)).
120
121:- export(e_reader_test/0). 122e_reader_test:- with_e_sample_tests(convert_e(user_output)).
123:- export(e_reader_test/1). 124e_reader_test(Files):- with_abs_paths(convert_e(user_output),Files).
125
126:- export(e_reader_testf/0). 127e_reader_testf:- with_e_sample_tests(convert_e(outdir('.', ep))).
128:- export(e_reader_testf/1). 129e_reader_testf(Files):- with_abs_paths(convert_e(outdir('.', ep)),Files).
130
131
132
133:- export(with_e_sample_tests/1). 134with_e_sample_tests(Out) :-
135 retractall(etmp:ec_option(load(_), _)),
138 139 140 141 142 143 144 call(Out, [ec('*/*/*/*.e'),ec('*/*/*.e'),ec('*/*.e')]),
145
147 !.
149
150
153
154raise_translation_event(Proc1,What,OutputName):- call(Proc1,:- call_pel_directive(translate(What,OutputName))).
155
156:- set_ec_option(overwrite_translated_files,false). 157
158:- export(should_update/1). 159should_update(OutputName):- is_filename(OutputName), \+ exists_file(OutputName), !.
160should_update(_):- etmp:ec_option(overwrite_translated_files,never),!,fail.
161should_update(_):- etmp:ec_option(overwrite_translated_files,always),!.
162should_update(_):- !.
163
164:- export(include_e/1). 165include_e(F):- with_e_file(do_convert_e, current_output, F).
166
167
168:- export(convert_e/1).
169convert_e(F):- convert_e(outdir('.', ep), F).
170:- export(convert_e/2).
171convert_e(Out, F):- with_e_file(do_convert_e, Out, F).
172:- export(convert_e/3).
173convert_e(Proc1, Out, F):- with_e_file(Proc1, Out, F).
174
175
177
178with_e_file(Proc1, OutputName, Ins):- wdmsg(with_e_file(Proc1, OutputName, Ins)),fail.
179
180with_e_file(Proc1, Out, F):- compound(Out), Out=outdir(Dir), !, with_e_file(Proc1, outdir(Dir, ep), F).
181
183with_e_file(Proc1, Out, F):- atom(F), \+ is_stream(F), \+ is_filename(F),
184 expand_file_name(F, L), L\==[], [F]\==L, !, maplist(with_e_file(Proc1, Out), L).
185
187with_e_file(Proc1, Out, F):- \+ is_stream(F), \+ is_filename(F),
188 findall(N, absolute_file_name(F, N, [file_type(txt), file_errors(fail), expand(false), solutions(all)]), L),
189 L\=[F], !, maplist(with_e_file(Proc1, Out), L).
190
191
192with_e_file(Proc1, Out, F):- nonvar(F), needs_resolve_local_files(F, L), !, maplist(with_e_file(Proc1, Out), L).
193
195with_e_file(Proc1, Outs, Ins):-
196 atomic(Outs), is_stream(Outs),
197 assertion(stream_property(Outs, output)),
198 \+ current_output(Outs), !,
199 with_output_to(Outs,
200 with_e_file(Proc1,current_output, Ins)),!.
201
203with_e_file(Proc1, OutputName, _Ins):- is_filename(OutputName),
204 \+ should_update(OutputName),
205 raise_translation_event(Proc1,skipped,OutputName),
206 raise_translation_event(Proc1,ready,OutputName), !.
207
209with_e_file(Proc1, outdir(Dir, Ext), F):- is_filename(F), !,
210 calc_where_to(outdir(Dir, Ext), F, OutputName),
211 with_e_file(Proc1, OutputName, F).
212
213with_e_file(Proc1, Out, F):- is_filename(F), !,
214 absolute_file_name(F,AF),
215 locally(b_setval('$ec_input_file',AF),
216 setup_call_cleanup(
217 open(F, read, Ins),
218 with_e_file(Proc1, Out, Ins),
219 close(Ins))),!.
220
222with_e_file(Proc1, outdir(Dir, Ext), Ins):- must(is_stream(Ins)), !,
223 must(stream_property(Ins, file(InputName))),
224 calc_where_to(outdir(Dir, Ext), InputName, OutputName),
225 with_e_file(Proc1, OutputName, Ins).
226
227
228
230with_e_file(MProc1, OutputName, Ins):- \+ is_stream(OutputName),
231 assertion(is_stream(Ins)), assertion(stream_property(Ins, input)),
232 with_e_file_write1(MProc1, OutputName, Ins).
233
235
236with_e_file(Proc1, Out, Ins):-
237 assertion(current_output(Out)),
238 e_io(Proc1, Ins).
239
240:- nb_setval(ec_input_file,[]). 241
242
243with_e_file_write1(MProc1, OutputName, Ins):- \+ is_stream(OutputName),
244 assertion(is_stream(Ins)), assertion(stream_property(Ins, input)),
245 must(should_update(OutputName)),
246 strip_module(MProc1,Mod,Proc1),
247 t_l:is_ec_cvt(FileType),!,
248 flag('$ec_translate_depth', Was, Was),
249 250 retractall(etmp:ec_option(load(_), _)),
251 setup_call_cleanup(flag('$ec_translate_depth', Was, Was+1),
252 setup_call_cleanup(open(OutputName, write, Outs),
253 setup_call_cleanup(b_setval('$ec_output_stream',Outs),
254 locally(b_setval('$ec_input_stream',Ins),
255 with_output_to(Outs,trans_e(FileType,Mod,Proc1,OutputName,Outs,Ins))),
256 b_setval('$ec_output_stream',[])),
257 close(Outs)),flag('$ec_translate_depth', _, Was)).
258
259trans_e(FileType,Mod,Proc1,OutputName,Outs,Ins):-
260 assertion(is_outputing_to_file),
261 raise_translation_event(Proc1,unskipped,OutputName),
262 format(Outs,'~N~q.~n',[( :- include(library('ec_planner/ec_test_incl')))]),
263 ignore((filetype_to_dialect(FileType,Dialect)->
264 format(Outs,'~N~q.~n',[ :- expects_dialect(Dialect)]))),
265 raise_translation_event(Proc1,begining,OutputName),
266 ignore((FileType\==pel,get_date_atom(DateAtom),format(Outs,'% ~w File: ~w',[DateAtom,Ins]))),
267 locally(t_l:is_ec_cvt(FileType), with_output_to(Outs,with_e_file(Mod:Proc1,Outs,Ins))),
268 raise_translation_event(Proc1,ending,OutputName),!.
269
270with_e_file_write2(Proc1, OutputName, Ins):- \+ is_stream(OutputName), !,
271 assertion(is_stream(Ins)), assertion(stream_property(Ins, input)),
272 must(should_update(OutputName)),
273 raise_translation_event(Proc1,unskipped,OutputName),
274 setup_call_cleanup(
275 open(OutputName, write, Outs),
276 with_output_to(Outs,
277 (raise_translation_event(Proc1,begining,OutputName),
278 nb_setval('$ec_output_stream',Outs),
279 format(Outs,'~N~q.~n',[:- expects_dialect(ecalc)]),
280 with_e_file(Proc1, current_output, Ins),
281 raise_translation_event(Proc1,ending,OutputName))),
282 (nb_setval('$ec_output_stream',[]),close(Outs))),
283 raise_translation_event(Proc1,ready,OutputName).
284
285
287e_io(Proc1, Ins):-
288 repeat,
289 locally(b_setval('$ec_input_stream',Ins),once(process_e_stream(Proc1, Ins))),
290 notrace(at_end_of_stream(Ins)), !.
291
292
293
294removed_one_ws(S):-
295 peek_code(S, W), char_type(W, white), get_code(S, W), echo_format('~s', [[W]]).
296
297removed_n_chars(_S, N):- N<1, !.
298removed_n_chars(S, N):- get_code(S, _), Nm1 is N-1, removed_n_chars(S, Nm1).
299
300trim_off_whitepace(S):- repeat, \+ removed_one_ws(S).
301
302
303
304read_n_save_vars(Type, Codes):- read_some_vars(Codes, Vars),
305 asserta(etmp:temp_varnames(Type, Vars)).
306
307read_some_vars(Codes, Vars):-
308 maybe_o_s_l,
309 must(e_read3(Codes, VarNames)), !,
310 varnames_as_list(VarNames, Vars).
311
312varnames_as_list({A},[A]):- atom(A),!.
313varnames_as_list({A,B},Vars):- !,varnames_as_list({A},Vars1),varnames_as_list({B},Vars2),append(Vars1,Vars2,Vars).
314varnames_as_list(VarNames,Vars):- assertion(is_list(VarNames)), !, VarNames=Vars.
315
316upcased_functors(G):-
317 notrace((allow_variable_name_as_functor = N,
318 current_prolog_flag(N, Was))), !,
319 setup_call_cleanup(notrace(set_prolog_flag(N, true)),
320 G,
321 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).
329process_stream_peeked213(S, "#!"):- !, read_line_to_string_echo(S, _).
330process_stream_peeked213(S, ";:-"):- !,
331 ( ( nb_current(last_e_string, axiom)) -> (echo_format('~N~n~n',[]), mention_s_l) ; true),
332 get_char(S, ';'), read_term(S, Term, []),!,
333 portray_clause(Term),nl,
334 nb_setval(last_e_string, axiom).
335
336process_stream_peeked213(S, ";"):- !,
337 ( ( nb_current(last_e_string, axiom)) -> (echo_format('~N~n~n',[]), mention_s_l) ; true),
338 echo_format('%'), read_line_to_string_echo(S, _),!,
339 nb_setval(last_e_string, cmt).
340process_stream_peeked213(S, "["):- !,
341 locally(b_setval(e_echo, nil), read_stream_until(S, [], `]`, Codes)),
342 ( (\+ nb_current(last_e_string, cmt), \+ nb_current(last_e_string, vars) ) -> (echo_format('~N~n~n',[]), mention_s_l) ; true),
343 echo_format('% ~s~N',[Codes]),
344 read_n_save_vars(universal, Codes),
345 nb_setval(last_e_string, vars).
346process_stream_peeked213(S, "{"):- mention_s_l, echo_format('% '), !, read_stream_until(S, [], `}`, Codes), read_n_save_vars(existential, Codes).
347
348
350process_e_stream(Proc1, S):- notrace(at_end_of_stream(S)), !, mention_s_l, call(Proc1, end_of_file).
351process_e_stream(_, S) :- removed_one_ws(S), !.
352process_e_stream(_, S):- process_stream_comment(S), !.
353
354process_e_stream(Proc1, S):-
355 OR = [to_lower('.'), to_lower('('), end_of_line, to_lower('='),to_lower('>'), space, to_lower(':')],
356 locally(b_setval(e_echo, nil),
357 read_stream_until_true(S, [], char_type_inverse(Was, or(OR)), Text)),
358 unpad_codes(Text, Codes),
359 maybe_o_s_l,
360 ttyflush,
361 must(continue_process_e_stream(Proc1, S, Codes, Was)), !.
362process_e_stream(Proc1, S):- read_line_to_string(S, Comment), echo_format('~N%RROOR: ~w: ~s~n', [Proc1, Comment]), break.
363
364
366continue_process_e_stream(_Proc1, _S, [], _):- !.
367continue_process_e_stream(_Proc1, _S, [], end_of_line):- !.
368continue_process_e_stream(Proc1, S, NextCodes, CanBe ):- ttyflush,
369 continue_process_e_stream_too(Proc1, S, NextCodes, CanBe ),!.
370
371continue_process_e_stream_too(Proc1, _S, Codes, to_lower(':')):-
372 append(Delta, [_], Codes),
373 text_to_string(Delta,DeltaS),
374 normalize_space(atom(Term),DeltaS),
375 nb_setval(last_e_string, delta),
376 echo_format('~N~n'),maybe_mention_s_l(0), echo_format('% ~s ', [Codes]),
377 ec_on_read(Proc1, directive(Term)),!.
378continue_process_e_stream_too(Proc1, S, Codes, space):- last(Codes, Last),
379 once([Last]=`!`;char_type(Last, alpha)), !,
380 trim_off_whitepace(S), !,
381 atom_codes(Token, Codes),
382 nb_setval(last_e_string, kw),
383 echo_format('~N~n'),maybe_mention_s_l(0), echo_format('% ~s ', [Codes]),
384 process_e_stream_token(Proc1, Token, S), ttyflush, !.
385continue_process_e_stream_too(Proc1, S, NextCodes, _CanBe ):- !,
386 ( \+ nb_current(last_e_string, vars) -> (echo_format('~N~n~n',[]), mention_s_l) ; true),
387 maybe_mention_s_l(2), echo_format('% ~s', [NextCodes]),
388 last(NextCodes, Last), cont_one_e_compound(S, NextCodes, Last, Term), ec_on_read(Proc1, Term).
389
390unpad_codes(Text, Codes):- text_to_string(Text, String),
391 normalize_space(codes(Codes0), String),
392 trim_eol_comment(Codes0,Codes).
393
(Codes,Left):- append(Left,[59|_Cmt], Codes),!.
395trim_eol_comment(Codes,Codes).
396
397
398e_from_atom(String, Term):- e_read1(String, Term, _).
399
400set_e_ops(M):-
401 op(1150, yfx, M:'->'),
402 op(1150, xfx, M:'->'),
403 op(1150, xfy, M:'->'),
404 405 op(1100, xfy, M:'<->'),
406 op(1075, xfx, M:'thereExists'),
407 op(1050, xfy, M:'|'),
408 op(950, xfy, M:'&'),
409 op(900, fx, M:'!'),
410 op(400, yfx, M:'%'),
411 op(1,fx,(M:($))).
412
413e_read3(String, Term):-
414 M = ecread,
415 forall(current_op(_,fx,OP),
416 op(0,fx,(M:OP))),
417 set_e_ops(M),
418 upcased_functors(notrace(((catch(
419 (read_term_from_atom(String, Term,
420 [var_prefix(true),variable_names(Vars), module(M)])), _, fail))))), !,
421 maplist(ignore, Vars).
422
423:- dynamic(etmp:temp_varnames/2).
424:- dynamic(etmp:ec_option/2). 425
426
427insert_vars(Term, [], Term, []).
428insert_vars(Term0, [V|LL], Term, [V=VV|Has]):-
429 insert1_var(Term0, V, VV, Term1),
430 insert_vars(Term1, LL, Term, Has).
431
432
433insert1_var(Term0, V, VV, Term1):-
434 debug_var(V, VV),
435 subst(Term0, V, VV, Term1).
436
437
438map_callables(_, Term0, Term):- \+ callable(Term0), !, Term0=Term.
439map_callables(_, Term0, Term):- []== Term0, !, Term =[].
440map_callables(Call, Term0, Term):- atom(Term0), !, call(Call, Term0, Term).
441map_callables(_Call, Term0, Term):- \+ compound(Term0), !, Term0=Term.
442map_callables(Call, Compound=Value, Term):- fail, compound(Compound),
443 append_term(Compound, Value, Term0), map_callables(Call, Term0, Term).
444map_callables(_, '$VAR'(HT), '$VAR'(HT)):-!.
445map_callables(Call, [H|T], [HTerm|TTerm]):- !, map_callables(Call, H, HTerm), map_callables(Call, T, TTerm), !.
446map_callables(Call, '$'(F, A), '$'(FF, AA)):- A==[], [] = AA, !, call(Call, F, FF).
448map_callables(Call, '$'(F, A), '$'(FF, AA)) :- call(Call, F, FF), maplist(map_callables(Call), A, AA), !.
449map_callables(Call, HT, HTTerm):- !,
450 compound_name_arguments(HT, F, L),
451 map_callables(Call, '$'(F, L), '$'(FF, LL)),
452 compound_name_arguments(HTTerm, FF, LL).
453
454
455:- export(fix_predname/2). 456
457fix_predname('!', 'not').
458fix_predname('~', 'not').
459
460fix_predname(';', ';').
461fix_predname('\\/', ';').
462fix_predname('v', ';').
463fix_predname('or', ';').
464fix_predname('|', ';').
465fix_predname('xor', 'xor').
466
467fix_predname(',', ',').
468fix_predname('^', ',').
469fix_predname('and', ',').
470fix_predname('&', ',').
471fix_predname('/\\', ',').
472
473fix_predname('equiv','<->').
474fix_predname('iff', '<->').
475fix_predname('<->', '<->').
476fix_predname('<=>', '<->').
477
478fix_predname('->', '->').
479fix_predname('implies', '->').
480fix_predname('=>', '->').
481fix_predname('if', '->').
482
483fix_predname(holds_at, holds_at).
484fix_predname(happens, happens_at).
485fix_predname(initiates, initiates_at).
486fix_predname(terminates, terminates_at).
487fix_predname(releases, releases_at).
488
489fix_predname(holdsat, holds_at).
490fix_predname(releasedat, released_at).
491fix_predname(at, at_loc).
492fix_predname(holds, pred_holds).
493fix_predname(is, pred_is).
494
495fix_predname(Happens, Happens):- builtin_pred(Happens).
496
497fix_predname(F, New):- downcase_atom(F, DC), F\==DC, !, fix_predname(DC, New).
498
499
500call_pel_directive(B):- pprint_ecp_cmt(red,call_pel_directive(B)).
501
502
503my_unCamelcase(X, Y):- atom(X), fix_predname(X, Y), !.
504my_unCamelcase(X, Y):- atom(X), upcase_atom(X, X), !, downcase_atom(X, Y).
505my_unCamelcase(X, Y):- unCamelcase(X, Y), !.
506
507:- export(e_to_pel/2). 508e_to_pel(C, C):- \+ callable(C), !.
509e_to_pel('$VAR'(HT), '$VAR'(HT)):-!.
510e_to_pel(X, Y):- \+ compound(X), !, must(my_unCamelcase(X, Y)).
511e_to_pel(X, Y):- compound_name_arity(X, F, 0), !, my_unCamelcase(F, FF), compound_name_arity(Y, FF, 0).
512e_to_pel(not(Term),not(Term)):- var(Term),!.
513e_to_pel(not(holds_at(Term,Time)),holds_at(O,Time)):- !, e_to_pel(not(Term), O).
514e_to_pel(not(Term),not(O)):- !, e_to_pel(Term, O).
515e_to_pel(Prop,O):-
516 Prop =.. [ThereExists,NotVars,Term0],
517 is_quantifier_type(ThereExists,_Exists),
518 conjuncts_to_list(NotVars,NotVarsL), select(NotVs,NotVarsL,Rest),compound(NotVs),not(Vars)=NotVs,
519 is_list(Vars), 520 (Rest==[]->Term1= Term0 ; list_to_conjuncts(Rest,NotVarsRest),conjoin(NotVarsRest,Term0,Term1)),
521 QProp =.. [ThereExists,Vars,Term1],
522 e_to_pel(not(QProp),O).
523e_to_pel(Prop,O):-
524 Prop =.. [ThereExists,Vars,Term0],
525 is_quantifier_type(ThereExists,Exists),
526 is_list(Vars), forall(member(E,Vars),ground(E)),
527 QProp =.. [Exists,Vars,Term0],
528 insert_vars(QProp, Vars, Term, _Has),
529 e_to_pel(Term,O),!.
530
534e_to_pel(t(X, [Y]), O):- nonvar(Y), !, e_to_pel(t(X, Y), O).
535e_to_pel(load(X), load(X)):-!.
536e_to_pel(include(X), include(X)):-!.
537e_to_pel(option([N, V]), O):- !, e_to_pel(option(N, V), O).
538e_to_pel(range([N, V, H]), O):- !, e_to_pel(range(N, V, H), O).
539
540e_to_pel(t(X, Y), O):- atom(X), is_non_sort(X), !, SS=..[X, Y], e_to_pel(SS, O).
541e_to_pel(t(X, Y), O):- atom(X), is_list(Y), is_non_sort(X), SS=..[X|Y], e_to_pel(SS, O).
542e_to_pel(t(X, Y), O):- atom(X), is_list(Y), SS=..[X, Y], e_to_pel(SS, O).
543e_to_pel(sort(col([S1, S2])), O):- !, e_to_pel(subsort(S1, S2), O).
544e_to_pel(function(F, [M]), O):- e_to_pel(function(F, M), O).
552e_to_pel(HT, HTTermO):- !,
553 compound_name_arguments(HT, F, L),
554 maplist(e_to_pel,L,LL),
555 compound_name_arguments(HTTerm, F, LL),
556 map_callables(my_unCamelcase, HTTerm, HTTermO).
557
558
559vars_verbatum(Term):- \+ compound_gt(Term, 0), !.
560vars_verbatum(Term):- compound_name_arity(Term, F, A), (verbatum_functor(F);verbatum_functor(F/A)), !.
561
562add_ec_vars(Term0, Term, Vs):- vars_verbatum(Term0), !, Term0=Term, Vs=[].
563add_ec_vars(Term0, Term, Vs):-
564 get_vars(universal, UniVars),
565 get_vars(existential,ExtVars),
566 insert_vars(Term0, UniVars, Term1, VsA),!,
567 add_ext_vars(VsA, ExtVars, Term1, Term, Vs), !.
568
569add_ext_vars(Vs, [], Term, Term, Vs):- !.
570add_ext_vars(VsA, LLS, Term0, Term, Vs):- use_some,
571 insert_vars((some(LLS), Term0), LLS, Term, VsB), !,
572 append(VsA,VsB,Vs),!.
573add_ext_vars(VsA, LLS, Term0, Term, Vs):-
574 insert_vars(exists(LLS, Term0), LLS, Term, VsB), !,
575 append(VsA,VsB,Vs),!.
576
577use_some :- fail.
578
579get_vars(Type,LLS):- findall(E, (etmp:temp_varnames(Type,L), member(E, L)), LL), sort(LL, LLS),!.
580
581
582e_read1(String, Term, Vs):-
583 e_read2(String, Term0), !,
584 add_ec_vars(Term0, Term1, Vs), !,
585 retractall(etmp:temp_varnames(_,_)),
586 e_to_pel(Term1, Term), !.
587
588if_string_replace(T, B, A, NewT):-
589 atomics_to_string(List, B, T), List=[_,_|_], !,
590 atomics_to_string(List, A, NewT).
591
592
593e_read2(Txt, Term):- \+ string(Txt), text_to_string(Txt, T),!, e_read2(T, Term).
594e_read2(T, Term):- if_string_replace(T, '!=', (\=), NewT), !, e_read2(NewT, Term).
595e_read2(T, Term):- if_string_replace(T, '%', (/), NewT), !, e_read2(NewT, Term).
596e_read2(T, Term):- use_some,
597 if_string_replace(T, '{', ' some( ', T1),
598 if_string_replace(T1, '}', ' ) & ', NewT),
599 e_read2(NewT, Term).
600e_read2(T, Term):-
601 if_string_replace(T, '{', ' [ ', T1),
602 if_string_replace(T1, '}', ' ] thereExists ', NewT),
603 e_read2(NewT, Term).
606e_read2(T, Term):- e_read3(T, Term), !.
607e_read2(T, Term):-
608 must(e_read3(T, Term)), !.
609
610
611
612cleanout(Orig, B, E, MidChunk, RealRemainder):-
613 text_to_string(Orig, Str),
614 AfterFirstB=[_|_],
615 atomic_list_concat([BeforeB|AfterFirstB], B, Str),
616 atomics_to_string( AfterFirstB, B, AfterB),
617 Remainder=[_|_],
618 atomic_list_concat([Mid|Remainder], E, AfterB),
619 atomics_to_string( Remainder, E, AfterE),
620 atomics_to_string( [BeforeB,' ', AfterE], RealRemainder),
621 atomics_to_string( [B, Mid, E], MidChunk).
622
623
624read_one_e_compound(S, Term):-
625 read_stream_until_true(S, [], char_type_inverse(_Was, or([to_lower('.'), end_of_line])), Text),
626 unpad_codes(Text, Codes), last(Codes, Last),
627 cont_one_e_compound(S, Codes, Last, Term).
628
629cont_one_e_compound(_S, Text, Last, Term):- char_type(Last, to_lower('.')),
630 unpad_codes(Text, Codes), e_from_atom(Codes, Term), nb_setval(last_e_string, axiom).
631
632cont_one_e_compound(_S, Text, Last, Term):- char_type(Last, to_lower(')')),
633 \+ (member(T, `>&|`), member(T, Text)),
634 unpad_codes(Text, Codes), e_from_atom(Codes, Term), nb_setval(last_e_string, axiom).
635
636cont_one_e_compound(S, InCodes, WasLast, Term):- process_stream_comment(S), !, cont_one_e_compound(S, InCodes, WasLast, Term).
637cont_one_e_compound(S, InCodes, WasLast, Term):-
638 (WasLast\==40-> echo_format('% ') ; true),
639 read_stream_until_true(S, InCodes, char_type_inverse(_Was, or([to_lower('.'), end_of_line])), Text),
640 unpad_codes(Text, Codes), last(Codes, Last),
641 cont_one_e_compound(S, Codes, Last, Term).
642
643
645
646:- meta_predicate ec_on_each_read(1,*,*). 647
648ec_on_read(Proc1, EOF):- EOF == end_of_file, !, must(call(Proc1, EOF)).
649ec_on_read(Proc1, SL):- e_to_pel(SL, SO) -> SL\=@=SO, !, ec_on_read(Proc1, SO).
650ec_on_read(Proc1, Cmp):- compound_gt(Cmp, 0),
651 Cmp =.. [NonlistF, List], is_list(List), non_list_functor(NonlistF),!,
652 maplist(ec_on_each_read(Proc1,NonlistF), List).
653ec_on_read(Proc1, SL):- e_to_pel2(SL,SO) -> SL\=@=SO, !, ec_on_read(Proc1, SO).
654ec_on_read(Proc1, S):- must(glean_data(Proc1, S)), must(call(Proc1, S)).
655
656e_to_pel2(X,Y):- compound(X),compound_name_arguments(X,N,[_A|_Args]),N=translate,!,Y= (:- call_pel_directive(X)).
657e_to_pel2(X,Y):- compound(X),compound_name_arguments(X,N,[_A|_Args]),pel_directive(N),!,Y= (:- call_pel_directive(X)).
658e_to_pel2(X,X).
659
660:- use_module(library(logicmoo/misc_terms)). 661
662ec_on_each_read(Proc1, NonlistF, E):- univ_safe(Cmp , [NonlistF, E]), ec_on_read(Proc1, Cmp).
663
666
667on_convert_ele(Var):- var(Var), !, throw(var_on_convert_ele(Var)).
668on_convert_ele(translate(Event, Outfile)):- !, must((mention_s_l, echo_format('~N% translate: ~w File: ~w ~n',[Event, Outfile]))).
669on_convert_ele(include(S0)):- resolve_local_files(S0,SS), !, maplist(include_e, SS), !.
671on_convert_ele(end_of_file):-!.
672on_convert_ele(SS):- must(echo_format('~N')), must(pprint_ecp(e,SS)).
673
674
675do_convert_e(SS):- on_convert_ele(SS).
676
677
678glean_data(Pred1, SL):- \+ compound(SL), !, dmsg(warn(glean_data(Pred1, SL))).
679glean_data(Pred1, subsort(S1, S2)):- !, glean_data(Pred1, sort(S1)), glean_data(Pred1, sort(S2)), assert_gleaned(Pred1, subsort(S1, S2)).
680glean_data(Pred1, sort(S)):- !, assert_gleaned(Pred1, sort(S)).
681glean_data(Pred1, isa(E, S)):- !, assert_gleaned(Pred1, isa(E, S)).
682glean_data(Pred1, SL):- SL=..[S, L],
683 \+ is_non_sort(S), is_list(L), !,
684 glean_data(Pred1, sort(S)),
685 maplist(glean_data(Pred1, hasInstance(S)), L).
686glean_data(_, _).
687
689assert_gleaned(_Pred1, SS):- asserta_if_new(gleaned(SS)).
691
692glean_data(Pred1, hasInstance(S), E):- !, glean_data(Pred1, isa(E, S)).
693
694
695
696process_e_stream_token(Proc1, Atom, S):- atom_concat(New, '!', Atom), !, process_e_stream_token(Proc1, New, S).
697process_e_stream_token(Proc1, Type, S):- normalize_space(atom(A), Type), A\==Type, !, process_e_stream_token(Proc1, A, S).
698process_e_stream_token(Proc1, Text, S):- \+ atom(Text), !, text_to_string(Text, String), atom_string(Atom,String), process_e_stream_token(Proc1, Atom, S).
699process_e_stream_token(Proc1, function, S):- !, read_stream_until(S, [], `:`, Text), read_line_to_string_echo(S, String),
700 append(TextL, [_], Text),
701 e_read1(TextL, Value, _),
702 token_stringsss(String, Type),
703 ec_on_read(Proc1, (function(Value, Type))).
704
705process_e_stream_token(Proc1, Type, S):- downcase_atom(Type, Event), (memberchk(Event, [fluent, predicate, event]);is_reified_sort(Event)), !,
706 read_one_e_compound(S, Value), ec_on_read(Proc1, t(Event, Value)).
707
708process_e_stream_token(Proc1, reified, S):- !, read_stream_until(S, [], ` `, Text),
709 text_to_string(Text, St), atom_concat('reified_', St, Type), !, process_e_stream_token(Proc1, Type, S).
710
711process_e_stream_token(Proc1, Type, S):- read_line_to_string_echo(S, String), process_e_token_with_string(Proc1, Type, String).
712
713process_e_token_with_string(Proc1, Type, String):- \+ is_non_sort(Type),
714 715 atomics_to_string(VList, ',', String), VList \= [_], !,
716 maplist(process_e_token_with_string(Proc1, Type), VList).
717process_e_token_with_string(_, _, ""):-!.
718process_e_token_with_string(Proc1, Type, String):- token_stringsss(String, Out), ec_on_read(Proc1, t(Type, Out)).
719
720token_stringsss("", []):-!.
721token_stringsss(T, Out) :- if_string_replace(T, ' ', ' ', NewT), !, token_stringsss(NewT, Out).
722token_stringsss(T, Out) :- if_string_replace(T, ': ', ':', NewT), !, token_stringsss(NewT, Out).
723token_stringsss(T, Out) :- if_string_replace(T, ' :', ':', NewT), !, token_stringsss(NewT, Out).
724token_stringsss(String, Out):- normalize_space(string(S), String), S\==String, !, token_stringsss(S, Out).
725token_stringsss(String, VVList):- atomics_to_string(VList, ',', String), VList \= [_], remove_blanks_col(VList, VVList), !.
726token_stringsss(String, col(VVList)):- atomics_to_string(VList, ':', String), VList \= [_], remove_blanks(VList, VVList), !.
727token_stringsss(String, VVList):- atomics_to_string(VList, ' ', String), remove_blanks(VList, VVList), !.
728
729remove_blanks_col(I, O):- remove_blanks(I, M),maplist(token_cols, M, O).
730
731token_cols(String, col(VVList)):- atomics_to_string(VList, ':', String), VList \= [_], remove_blanks(VList, VVList), !.
732token_cols(String,String).
733
734remove_blanks([], []).
735remove_blanks([''|I], O):- !, remove_blanks(I, O).
736remove_blanks([E|I], O):- string(E), normalize_space(string(EE), E), E\==EE, !, remove_blanks([EE|I], O).
737remove_blanks([E|I], O):- atom(E), normalize_space(atom(EE), E), E\==EE, !, remove_blanks([EE|I], O).
738remove_blanks([E|I], O):- to_atomic_value(E, EE), E\==EE, !, remove_blanks([EE|I], O).
739remove_blanks([E|I], [E|O]):- remove_blanks(I, O).
740
741
742to_atomic_value(A, N):- number(A), !, N=A.
743to_atomic_value(A, N):- normalize_space(atom(S), A), S\==A, !, to_atomic_value(S, N).
744to_atomic_value(A, N):- atom_number(A, N).
745to_atomic_value(A, A).
746
747:- meta_predicate(read_stream_until(+,+,*,-)). 748read_stream_until(S, Buffer, [Until], Codes):- !, name(N, [Until]), char_code(N, UntilCode), !,
749 read_stream_until_true(S, Buffer, ==(UntilCode), Codes).
750read_stream_until(S, Buffer, UntilCode, Codes):- integer(UntilCode), !,
751 read_stream_until_true(S, Buffer, ==(UntilCode), Codes).
752read_stream_until(S, Buffer, Until, Codes):- atom(Until), atom_length(Until, 1), char_code(Until, UntilCode), !,
753 read_stream_until_true(S, Buffer, ==(UntilCode), Codes).
754read_stream_until(S, Buffer, Until, Codes):- read_stream_until_true(S, Buffer, Until, Codes).
755
756char_type_inverse(Type, or(TypeList), Code):- !, member(E, TypeList), char_type_inverse(Type, E, Code).
757char_type_inverse(Type, [Spec], Code):- !, char_type_inverse(Type, Spec, Code).
758char_type_inverse(Type, [Spec|List], Code):- !, char_type_inverse(_, Spec, Code), char_type_inverse(Type, List, Code).
759char_type_inverse(Type, Spec, Code):- char_type(Code, Spec), Type=Spec.
760
761read_stream_until_true(S, Buffer, Proc1, Buffer):- at_end_of_stream(S), !, ignore(call(Proc1, 10)).
762read_stream_until_true(S, Buffer, Proc1, Codes):- get_code(S, Char),
763 (nb_current(e_echo,nil) -> true; put_out(Char)),
764 (call(Proc1, Char) -> notrace(append(Buffer, [Char], Codes)) ;
765 (notrace(append(Buffer, [Char], NextBuffer)), read_stream_until_true(S, NextBuffer, Proc1, Codes))).
766
767
784
785
786
787till_eof(In) :-
788 repeat,
789 ( at_end_of_stream(In)
790 -> !
791 ; (read_pending_codes(In, Chars, []),
792 (t_l:echo_mode(echo_file) ->
793 echo_format('~s', [Chars]);
794 true),
795 fail)
796 ).
797
798
799:- fixup_exports.