30
31:- module(ciao,
32 [
33 '$ciao_meta'/2,
34 '$ciao_meta'/3,
35 '$ciao_meta'/4,
36 '$ciao_meta'/5,
37 '$ciao_meta'/6,
38 '$ciao_meta'/7,
39 '$ciao_meta'/8,
40 op(1150, fx, data)
41 ]). 42:- use_module(library(error)). 43:- use_module(library(apply)). 44:- use_module(library(debug)).
62:- multifile
63 system:goal_expansion/2,
64 system:term_expansion/2,
65 ciao_trans/4,
66 ciao_trans_db/5,
67 ciao_goal_expansion/2,
68 ciao_term_expansion/2,
69 user:file_search_path/2. 70
71
72 75
76user:file_search_path(engine, library(dialect/ciao/engine)).
77
78
79 82
83:- create_prolog_flag(multi_arity_warnings, off, [type(atom)]). 84:- create_prolog_flag(discontiguous_warnings, on, [type(atom)]). 85
86:- multifile
87 declaration/2, 88 declaration_hook/2. 89
90:- dynamic
91 lock_expansion/0,
92 old_flag/3. 93
94compilation_module(CM) :- 95 96 97 '$current_source_module'(M),
98 compilation_module(M, CM).
99
100compilation_module(M, CM) :-
101 atom_concat(M, '$ciao', CM).
102 103 104 105
106call_lock(Goal) :-
107 setup_call_cleanup((\+ lock_expansion,assertz(lock_expansion)),
108 Goal, retract(lock_expansion)).
109
110system:goal_expansion(In, Out) :-
111 prolog_load_context(dialect, ciao),
112 compilation_module(CM),
113 ciao_trans(CM, goal, In, Out1), 114 ( In == end_of_file 115 -> Out = true
116 ; Out = Out1
117 ).
118system:goal_expansion(In, Out) :-
119 prolog_load_context(dialect, ciao),
120 ciao_goal_expansion(In, Out). 121
122system:term_expansion(In, Out) :-
123 prolog_load_context(dialect, ciao),
124 compilation_module(CM),
125 call_lock((ciao_trans(CM, sentence, In, Out1), 126 '$expand':expand_terms(call_term_expansion([system-[term_expansion/2]]),
127 Out1, _, Out2, _) 128 )),
129 call_eof_goal_hook(In, Out2, Out).
130system:term_expansion(In, Out) :-
131 prolog_load_context(dialect, ciao),
132 ciao_term_expansion(In, Out).
133
134call_eof_goal_hook(In, Out2, Out) :-
135 '$current_source_module'(M),
136 ( In == end_of_file,
137 module_property(M, file(File)),
138 prolog_load_context(file, File) 139 -> ( is_list(Out2)
140 -> append(Out2, [(:- end_of_file)], Out)
141 ; Out = [Out2, (:- end_of_file)]
142 ) 143 ; Out = Out2
144 ).
145
146package_file(F, P) :-
147 ( atom(F) -> P = library(F)
148 ; functor(F, _, 1) -> P = F
149 ).
150
151package_directive(Package, Directive) :-
152 expand_term((:- use_package(Package)), Directive).
153
154ciao_term_expansion((:- module(Name, Public, Packages)),
155 [ (:- module(Name, Public)),
156 (:- style_check(-singleton)),
157 (:- expects_dialect(ciao)),
158 (:- use_module(engine(basic_props))),
159 (:- use_module(engine(io_aux))),
160 (:- use_module(engine(exceptions)))
161 | Directives
162 ]) :-
163 maplist(package_directive, Packages, Directives).
164
165map_ciaoname_rec(Ciao, Path, Path/Ciao) :- atom(Ciao), !.
166map_ciaoname_rec(Ciao0, Path, SWI) :-
167 Ciao0 =.. [F, Ciao],
168 map_ciaoname_rec(Ciao, Path/F, SWI).
169
170map_ciaoname_(Path, Path) :- atom(Path), !.
171map_ciaoname_(Ciao0, SWI) :-
172 Ciao0 =.. [F, Ciao],
173 map_ciaoname_rec(Ciao, F, SWI).
174
175map_ciaoname(CiaoName, SWIName) :-
176 CiaoName =.. [F, C],
177 SWIName =.. [F, S],
178 map_ciaoname_(C, S).
179
180ciao_term_expansion((:- use_package(CiaoPack)),
181 (:- include(SWIName))) :-
182 package_file(CiaoPack, CiaoName),
183 map_ciaoname(CiaoName, SWIName).
184ciao_term_expansion((:- new_declaration(Name/Arity)), Exp) :-
185 '$current_source_module'(M),
186 functor(Head, Name, Arity),
187 ( ciao:declaration(Head, M)
188 -> Exp = []
189 ; Exp = ciao:declaration(Head, M)
190 ).
191ciao_term_expansion((:- package(_Package)), []).
192ciao_term_expansion((:- Decl), Exp) :-
193 '$current_source_module'(M),
194 declaration(Decl, M),
195 ( declaration_hook(Decl, Exp)
196 -> true
197 ; functor(Decl, Name, Arity),
198 prolog_load_context(module, Module),
199 current_predicate(Module:Name/Arity)
200 -> Exp = (:- Decl)
201 ; Exp = []
202 ).
210map_metaspecs(Var, _) -->
211 { var(Var), !,
212 instantiation_error(Var)
213 }.
214map_metaspecs((A0,B0), (A,B)) --> !,
215 map_metaspecs(A0, A),
216 map_metaspecs(B0, B).
217map_metaspecs(Head0, Head) -->
218 { functor(Head0, Name, Arity),
219 functor(Head, Name, Arity),
220 functor(HeadIn, Name, Arity),
221 HeadIn =.. [Name|ArgsIn],
222 meta_expansion(Head0, Head, HeadIn, M, RequiresModule, ArgsOut, [])
223 },
224 ( { ArgsIn == ArgsOut } -> []
225 ; { HeadOut =.. [Name|ArgsOut] },
226 ( {RequiresModule==1} ->
227 [ (:- module_transparent(Name/Arity)) ],
228 { Body = (context_module(M), HeadOut) }
229 ; { Body = HeadOut }
230 ),
231 [ (HeadIn :- Body) ]
232 ).
233
234map_metaspec(Var, ?) :-
235 var(Var), !.
236map_metaspec(goal, 0).
237map_metaspec(clause, :).
238map_metaspec(fact, :).
239map_metaspec(spec, :).
240map_metaspec(pred(N), N).
241map_metaspec(?, ?).
242map_metaspec(+, +).
243map_metaspec(-, -).
244
245module_sensitive(goal).
246module_sensitive(clause).
247module_sensitive(fact).
248module_sensitive(spec).
249module_sensitive(pred(_)).
250
251meta_expansion(Head0, Head, HeadIn, M, RequiresModule) -->
252 meta_expansion_args(1, Head0, Head, HeadIn, M, RequiresModule).
253
254meta_expansion_arg(Spec, TSpec, Arg, _, _) -->
255 {map_metaspec(Spec, TSpec)}, !,
256 [Arg].
257meta_expansion_arg(addmodule(Spec), TSpec, Arg, M, 1) --> !,
258 meta_expansion_arg(Spec, TSpec, Arg, M, _),
259 [M].
260meta_expansion_arg(addterm(Spec), TSpec, Arg0, M, R) --> !,
261 meta_expansion_arg(Spec, TSpec, Arg0, M, R),
262 { module_sensitive(Spec) -> Arg0 = _:Arg
263 ; Arg0 = Arg
264 },
265 [Arg].
266meta_expansion_arg(addmodule, TSpec, Arg, M, R) --> !,
267 meta_expansion_arg(addmodule(?), TSpec, Arg, M, R).
268meta_expansion_arg(addterm, TSpec, Arg, M, R) --> !,
269 meta_expansion_arg(addterm(?), TSpec, Arg, M, R).
270meta_expansion_arg(Spec, Spec, Arg, _, _) --> [Arg].
271
272meta_expansion_args(N, Meta, Head, HeadIn, M, R) -->
273 {arg(N, Meta, Spec)},
274 {arg(N, Head, TSpec)},
275 {arg(N, HeadIn, Arg)},
276 meta_expansion_arg(Spec, TSpec, Arg, M, R),
277 {N1 is N + 1},
278 !,
279 meta_expansion_args(N1, Meta, Head, HeadIn, M, R).
280meta_expansion_args(_, _, _, _, _, _) --> [].
281
282ciao_term_expansion((:- use_module(CiaoName)), (:- use_module(SWIName))) :-
283 map_ciaoname(CiaoName, SWIName).
284ciao_term_expansion((:- use_module(CiaoName, L)), (:- use_module(SWIName, L))) :-
285 map_ciaoname(CiaoName, SWIName).
286ciao_term_expansion((:- include(CiaoName)), (:- include(SWIName))) :-
287 map_ciaoname(CiaoName, SWIName).
288ciao_term_expansion((:- reexport(CiaoName)), (:- reexport(SWIName))) :-
289 map_ciaoname(CiaoName, SWIName).
290ciao_term_expansion((:- reexport(CiaoName, L)), (:- reexport(SWIName, L))) :-
291 map_ciaoname(CiaoName, SWIName).
292ciao_term_expansion((:- meta_predicate(CiaoSpec)),
293 [ (:- meta_predicate(SWISpec))
294 | Wrappers
295 ]) :-
296 ( phrase(map_metaspecs(CiaoSpec, SWISpec), Wrappers)
297 -> true
298 ; debug(ciao, 'Failed to translate ~q',
299 [(:- meta_predicate(CiaoSpec))]),
300 fail
301 ).
302ciao_term_expansion((:- data(Data)), (:- dynamic(Data))).
303ciao_term_expansion((:- primitive_meta_predicate(CiaoSpec)), SWIDecl) :-
304 expand_term((:- meta_predicate(CiaoSpec)), SWIDecl).
305ciao_term_expansion((:- redefining(F/A)), (:- redefine_system_predicate(H))) :-
306 functor(H, F, A).
307ciao_term_expansion((:- load_compilation_module(CiaoName)),
308 [(:- CM:use_module(SWIName))]) :-
309 compilation_module(CM),
310 map_ciaoname(CiaoName, SWIName).
311ciao_term_expansion((:- add_sentence_trans(F/A, P)),
312 [ciao:ciao_trans_db(CM, sentence, P, F, A)|Clauses]) :-
313 '$current_source_module'(M),
314 compilation_module(M, CM),
315 ( current_predicate(CM:F/A) ->
316 functor(H, F, A),
317 arg(1, H, 0),
318 arg(2, H, CL),
319 ignore(arg(3, H, M)),
320 ignore(CM:H),
321 ( var(CL)
322 -> Clauses = []
323 ; is_list(CL)
324 -> Clauses = CL
325 ; Clauses = [CL]
326 )
327 ; throw(error(existence_error(add_sentence_trans, F/A), _))
328 ).
329ciao_term_expansion((:- add_goal_trans(F/A, P)),
330 ciao:ciao_trans_db(CM, goal, P, F, A)) :-
331 compilation_module(CM),
332 ( current_predicate(CM:F/A) -> true
333 ; throw(error(existence_error(add_goal_trans, F/A), _))
334 ).
335ciao_term_expansion((H :- B), Clause) :-
336 337 338 H == B, !,
339 functor(H, F, A),
340 Clause = (:- export(F/A)).
341ciao_term_expansion((:- impl_defined(L)), Clauses) :-
342 '$current_source_module'(M),
343 findall(H, ( sequence_contains(L, bad_spec_error(impl_defined), F, A),
344 \+ current_predicate(M:F/A),
345 functor(H, F, A)
346 ),
347 Clauses). 348 349 350
351bad_spec_error(impl_defined, Spec) :-
352 throw(error(domain_error(predname, Spec), _)).
353
354:- meta_predicate sequence_contains(+,1,-,-). 355sequence_contains(V, BadP, _, _) :- var(V), !,
356 call(BadP, V), fail.
357sequence_contains([], _, _, _) :- !, fail.
358sequence_contains([S|Ss], BadP, F, A) :- !,
359 ( sequence_contains(S, BadP, F, A)
360 ; sequence_contains(Ss, BadP, F, A)
361 ).
362sequence_contains((S,Ss), BadP, F, A) :- !,
363 ( sequence_contains(S, BadP, F, A)
364 ; sequence_contains(Ss, BadP, F, A)
365 ).
366sequence_contains(F/A, _, F, A) :-
367 atom(F), integer(A), !.
368sequence_contains(S, BadP, _, _) :-
369 call(BadP, S), fail.
370
371get_expansor(F, A, M, Dict, Term0, Term, TR) :-
372 functor(TR, F, A),
373 arg(1, TR, Term0),
374 arg(2, TR, Term),
375 ignore(arg(3, TR, M)),
376 ignore(arg(4, TR, Dict)).
377
378call_sentence_expansion([], _, _, _, Term, Pos, Term, Pos).
379call_sentence_expansion([F/A|PIs], CM, M, Dict, Term0, Pos0, Term, Pos) :-
380 ( get_expansor(F, A, M, Dict, Term0, Term1, Expansor),
381 CM:Expansor ->
382 '$expand':expand_terms(ciao:call_sentence_expansion(PIs, CM, M, Dict),
383 Term1, Pos0, Term, Pos)
384 ; call_sentence_expansion(PIs, CM, M, Dict, Term0, Pos0, Term, Pos)
385 ).
386
387call_goal_expansion([], _, _, _, Term, Term).
388call_goal_expansion([F/A|PIs], CM, M, Dict, Term0, Term) :-
389 ( get_expansor(F, A, M, Dict, Term0, Term1, Expansor),
390 CM:Expansor -> true
391 ; Term0 = Term1
392 ),
393 call_goal_expansion(PIs, CM, M, Dict, Term1, Term).
394
395call_expansion(sentence, PIs, CM, M, Dict, Term0, Term) :-
396 call_sentence_expansion(PIs, CM, M, Dict, Term0, _, Term, _).
397call_expansion(goal, PIs, CM, M, Dict, Term0, Term) :-
398 call_goal_expansion(PIs, CM, M, Dict, Term0, Term).
399
400:- use_module(library(prolog_clause), []). 401:- use_module(library(pairs), [pairs_values/2]). 402
403get_expansors(CM, Trans, PIs) :-
404 findall(P-(F/A), ciao_trans_db(CM, Trans, P, F, A), UKPIs),
405 keysort(UKPIs, KPIs),
406 pairs_values(KPIs, PIs).
407
409ciao_trans(CM, Trans, Term0, Term) :-
410 get_expansors(CM, Trans, PIs),
411 PIs \= [],
412 '$current_source_module'(M),
413 b_getval('$variable_names', Dict),
414 call_expansion(Trans, PIs, CM, M, Dict, Term0, Term).
415
416swi_meta_arg(_, Arg, Arg) :-
417 (var(Arg) ; atom(Arg)), !.
418swi_meta_arg(_, M:Arg, M:Arg) :-
419 (var(M) ; atom(M)),
420 (var(Arg) ; atom(Arg)), !.
421swi_meta_arg(_, '$ciao_meta'(Arg), '$ciao_meta'(Arg)) :- !.
422swi_meta_arg(Meta, Arg, '$ciao_meta'(Arg)) :- integer(Meta), Meta > 0, !.
423swi_meta_arg(_, _, Arg, Arg).
424
425swi_meta_args(Spec, CiaoGoal, SWIGoal) :-
426 functor(CiaoGoal, F, A),
427 functor(SWIGoal, F, A),
428 swi_meta_args(1, Spec, CiaoGoal, SWIGoal).
429
430swi_meta_args(N, Spec, CiaoGoal, SWIGoal) :-
431 arg(N, Spec, Meta),
432 !,
433 arg(N, CiaoGoal, CiaoArg),
434 arg(N, SWIGoal, SWIArg),
435 swi_meta_arg(Meta, CiaoArg, SWIArg),
436 N1 is N + 1,
437 swi_meta_args(N1, Spec, CiaoGoal, SWIGoal).
438swi_meta_args(_, _, _, _).
445:- meta_predicate
446 '$ciao_meta'(1, ?),
447 '$ciao_meta'(2, ?, ?),
448 '$ciao_meta'(3, ?, ?, ?),
449 '$ciao_meta'(4, ?, ?, ?, ?),
450 '$ciao_meta'(5, ?, ?, ?, ?, ?),
451 '$ciao_meta'(6, ?, ?, ?, ?, ?, ?),
452 '$ciao_meta'(7, ?, ?, ?, ?, ?, ?, ?). 453
454'$ciao_meta'(M:P0, A1) :-
455 P0 =.. [F|Args],
456 P =.. [F, A1|Args],
457 call(M:P).
458'$ciao_meta'(M:P0, A1, A2) :-
459 P0 =.. [F|Args],
460 P =.. [F, A1|Args],
461 call(M:P, A2).
462'$ciao_meta'(M:P0, A1, A2, A3) :-
463 P0 =.. [F|Args],
464 P =.. [F, A1|Args],
465 call(M:P, A2, A3).
466'$ciao_meta'(M:P0, A1, A2, A3, A4) :-
467 P0 =.. [F|Args],
468 P =.. [F, A1|Args],
469 call(M:P, A2, A3, A4).
470'$ciao_meta'(M:P0, A1, A2, A3, A4, A5) :-
471 P0 =.. [F|Args],
472 P =.. [F, A1|Args],
473 call(M:P, A2, A3, A4, A5).
474'$ciao_meta'(M:P0, A1, A2, A3, A4, A5, A6) :-
475 P0 =.. [F|Args],
476 P =.. [F, A1|Args],
477 call(M:P, A2, A3, A4, A5, A6).
478'$ciao_meta'(M:P0, A1, A2, A3, A4, A5, A6, A7) :-
479 P0 =.. [F|Args],
480 P =.. [F, A1|Args],
481 call(M:P, A2, A3, A4, A5, A6, A7).
482
483ciao_foldl(L, S, O, R) :- foldl(O, L, S, R).
484
485ciao_goal_expansion(atom_concat(A, B), atomic_list_concat(A, B)) :- !.
486ciao_goal_expansion(asserta_fact(Fact), asserta(Fact)) :- !.
487ciao_goal_expansion(asserta_fact(Fact, Ref), asserta(Fact, Ref)) :- !.
488ciao_goal_expansion(assertz_fact(Fact), assertz(Fact)) :- !.
489ciao_goal_expansion(assertz_fact(Fact, Ref), assertz(Fact, Ref)) :- !.
490ciao_goal_expansion(retract_fact(Fact), retract(Fact)) :- !.
491ciao_goal_expansion(retract_fact_nb(Fact), retract(Fact)) :- !.
492ciao_goal_expansion(retract_fact(Fact, Ref), retract(Fact, Ref)) :- !.
493ciao_goal_expansion(retract_fact_nb(Fact, Ref), retract(Fact, Ref)) :- !.
494ciao_goal_expansion(retractall_fact(Fact), retractall(Fact)) :- !.
495ciao_goal_expansion(current_fact(Fact), clause(Fact, _)) :- !.
496ciao_goal_expansion(current_fact(Fact, Ref), clause(Fact, _, Ref)) :- !.
497ciao_goal_expansion(current_fact_nb(Fact), clause(Fact, _)) :- !.
498ciao_goal_expansion(current_fact_nb(Fact, Ref), clause(Fact, _, Ref)) :- !.
499ciao_goal_expansion('$exit'(Code), halt(Code)) :- !.
500ciao_goal_expansion('$metachoice'(Choice), prolog_current_choice(Choice)) :- !.
501ciao_goal_expansion('$metacut'(Choice), prolog_cut_to(Choice)) :- !.
502ciao_goal_expansion('$meta_call'(Goal), call(Goal)) :- !.
503ciao_goal_expansion('$setarg'(Arg, Term, Value, on), setarg(Arg, Term, Value)) :- !.
504ciao_goal_expansion('$setarg'(Arg, Term, Value, true), nb_setarg(Arg, Term, Value)) :- !.
505ciao_goal_expansion(instance(A, B), subsumes_term(B, A)) :- !.
506ciao_goal_expansion(varset(A, B), term_variables(A, B)) :- !.
507ciao_goal_expansion(foldl(L, S, O, R), ciao_foldl(L, S, O, R)) :- !.
508ciao_goal_expansion(attach_attribute(V, A), put_attr(V, attributes, A)) :- !.
509ciao_goal_expansion(detach_attribute(V), del_attr(V, attributes)) :- !.
510ciao_goal_expansion(update_attribute(V, A), put_attr(V, attributes, A)) :- !.
511ciao_goal_expansion(get_attribute(V, A), get_attr(V, attributes, A)) :- !.
512ciao_goal_expansion(mktemp_in_tmp(T, F), tmp_file(T, F)) :- !.
513
514ciao_goal_expansion(current_prolog_flag(F, V), G) :-
515 F == discontiguous_warnings,
516 !,
517 G = (style_check(?(discontiguous)) -> V = on ; v = off).
518ciao_goal_expansion(set_prolog_flag(F, V), G) :-
519 F == discontiguous_warnings,
520 !,
521 ( V == on -> G = style_check(+(discontiguous))
522 ; V == off -> G = style_check(-(discontiguous))
523 ).
524ciao_goal_expansion(push_prolog_flag(Flag, NewValue), G) :- !,
525 expand_push_prolog_flag(Flag, NewValue, G).
526ciao_goal_expansion(push_ciao_flag(Flag, NewValue), G) :- !,
527 expand_push_prolog_flag(Flag, NewValue, G).
528ciao_goal_expansion(pop_prolog_flag(Flag), G) :- !,
529 expand_pop_prolog_flag(Flag, G).
530ciao_goal_expansion(pop_ciao_flag(Flag), G) :- !,
531 expand_pop_prolog_flag(Flag, G).
532
533ciao_goal_expansion(CiaoGoal, SWIGoal) :-
534 CiaoGoal \= _:_,
535 \+ functor(CiaoGoal, '$ciao_meta', _),
536 '$current_source_module'(M),
537 predicate_property(M:CiaoGoal, meta_predicate(Spec)),
538 swi_meta_args(Spec, CiaoGoal, SWIGoal),
539 CiaoGoal \= SWIGoal.
540
541expand_push_prolog_flag(Flag, NewValue, G) :-
542 '$current_source_module'(M),
543 G = ( nonvar(Flag),
544 prolog_flag(Flag, OldValue, NewValue),
545 asserta(ciao:old_flag(M, Flag, OldValue))).
546
547expand_pop_prolog_flag(Flag, G) :-
548 '$current_source_module'(M),
549 G = ( nonvar(Flag),
550 once(retract(ciao:old_flag(M, Flag, OldValue))),
551 prolog_flag(Flag, _, OldValue)).
552
553
562push_ciao_library :-
563 ( absolute_file_name(library(dialect/ciao), Dir,
564 [ file_type(directory),
565 access(read),
566 solutions(all),
567 file_errors(fail)
568 ]),
569 asserta((user:file_search_path(library, Dir) :-
570 prolog_load_context(dialect, ciao))),
571 fail
572 ; true
573 ).
574
575
576:- push_ciao_library.
Ciao Prolog compatibility module
This module sets up support for loading Ciao Prolog modules that start with a :-
module(Name, Exports, Packages)
directive. Upon encountering this directive, it is rewritten into a SWI-Prolog module declaration, followed by a series of directives to setup Ciao compatibility.Typical usage for loading Ciao code is: