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