1:- module(casp_lang_en,
2 [ scasp_message//1
3 ]). 4:- use_module(library(dcg/high_order)). 5:- use_module('../ops', [op(_,_,_)]). 6:- use_module(library(lists), [reverse/2]). 7:- use_module(library(prolog_code), [comma_list/2]). 8
9:- multifile
10 scasp_messages:scasp_lang_module/2. 11
12scasp_messages:scasp_lang_module(en, casp_lang_en).
13
14:- multifile
15 prolog:error_message//1. 16
17prolog:error_message(existence_error(scasp_query, scasp_main)) -->
18 [ 'sCASP: the program does not contain a query'-[] ].
19prolog:error_message(existence_error(scasp_query, M)) -->
20 [ 'sCASP: no query in module ~p'-[M] ].
21
22
23 26
27scasp_message(version(Version)) -->
28 [ 'version ~w'-[Version] ].
29
31
32scasp_message(source_not_found(Source)) -->
33 ( \+ { access_file(Source, exist) }
34 -> [ 'Input file '-[] ], code(Source), [ ' does not exist'-[] ]
35 ; [ 'Cannot read input file '-[] ], code(Source)
36 ).
37scasp_message(no_input_files) -->
38 [ 'No input file specified!' ].
39scasp_message(no_query) -->
40 [ 'the program does not contain ?- Query.'-[] ].
41scasp_message(undefined_operator(Op)) -->
42 [ 'clp operator ~p not defined'-[Op] ].
43scasp_message(at_most_one_of([A,B])) -->
44 ['Options '], opt(A), [' and '], opt(B),
45 [' cannot be used together' ].
46scasp_message(at_most_one_of(List)) -->
47 [ 'At most one of the options '-[] ],
48 options(List),
49 [ ' is allowed.'-[] ].
50scasp_message(opt_dcc_prev_forall) -->
51 [ 'Option --dcc can only be used with --forall=prev' ].
52scasp_message(opt_incompatible(Opt1, Opt2)) -->
53 [ 'Option ' ], opt(Opt1), [' is not compatible with '], opt(Opt2).
54
56
57scasp_message(failure_calling_negation(Goal)) -->
58 [ 'Failure calling negation of '-[] ], goal(Goal).
59scasp_message(co_failing_in_negated_loop(Goal, NegGoal)) -->
60 [ 'Co-Failing in a negated loop due to a variant call'-[], nl,
61 '(extension clp-disequality required).'-[]
62 ],
63 curr_prev_goals(Goal, NegGoal).
64scasp_message(variant_loop(Goal, PrevGoal)) -->
65 [ 'Failing in a positive loop due to a variant call (tabling required).'-[]
66 ],
67 curr_prev_goals(Goal, PrevGoal).
68scasp_message(subsumed_loop(Goal, PrevGoal)) -->
69 [ 'Failing in a positive loop due to a subsumed call under clp(q).'-[]
70 ],
71 curr_prev_goals(Goal, PrevGoal).
72scasp_message(pos_loop(fail, Goal, PrevGoal)) -->
73 [ 'Positive loop failing '-[] ],
74 eq_goals(Goal, PrevGoal).
75
76scasp_message(pos_loop(continue, Goal, PrevGoal)) -->
77 [ 'Positive loop continuing '-[] ],
78 eq_goals(Goal, PrevGoal).
79scasp_message(trace_failure(Goal, Stack)) -->
80 print_check_calls_calling(Goal, Stack),
81 [ ansi(warning, 'FAILURE to prove the literal: ', []) ],
82 goal(Goal).
83
84scasp_message(dcc_call(Goal, Stack)) -->
85 [ 'DCC of ' ], goal(Goal),
86 [ ' in ' ], print_stack(Stack).
87scasp_message(dcc_discard(Goal, BodyL)) -->
88 { comma_list(Body, BodyL) },
89 [ 'DCC discards '], goal(Goal),
90 [ ' when checking nmr ~p'-[ dcc(Goal) :- Body ] ].
91
93
94scasp_message(no_models(CPU)) -->
95 [ 'No models (~3f seconds)'-[CPU] ].
96
97
99
100scasp_message(and) --> [ 'and' ].
101scasp_message(or) --> [ 'or' ].
102scasp_message(not) --> [ 'there is no evidence that' ].
103scasp_message(may) --> [ 'it may be the case that' ].
104scasp_message(-) --> [ 'it is not the case that' ].
105scasp_message(implies) --> [ 'because' ].
106scasp_message(?) --> [ '?' ].
107scasp_message(proved) --> ['justified above'].
108scasp_message(chs) --> ['it is assumed that'].
109scasp_message(assume) --> ['we assume that'].
110scasp_message(holds) --> [' holds'].
111scasp_message(holds_for) --> [' holds for '].
112scasp_message(not_in) --> ['not'].
113scasp_message('\u2209'(_,_)) --> ['not'].
114scasp_message(neq) --> ['not equal to'].
115scasp_message(_>_) --> ['is greater than'].
116scasp_message(_>=_) --> ['is greater than or equal to'].
117scasp_message(_<_) --> ['is less than'].
118scasp_message(_=<_) --> ['is less than or equal to'].
119scasp_message(_#=_) --> ['equal to'].
120scasp_message(_#<>_) --> ['not equal to'].
121scasp_message(_#>_) --> ['greater than'].
122scasp_message(_#>=_) --> ['greater than or equal to'].
123scasp_message(_#<_) --> ['less than'].
124scasp_message(_#=<_) --> ['less than or equal to'].
125scasp_message(global_constraints_hold) -->
126 [ 'The global constraints hold' ].
127scasp_message(global_constraint(N)) -->
128 [ 'the global constraint number ', N, ' holds' ].
129scasp_message(abducible) --> [ 'by abduction we conclude that' ].
130scasp_message(according_to) --> [ 'per' ].
131
132
133 136
137print_check_calls_calling(Goal, Stack) -->
138 [ansi(bold, '~`-t Calling: ~@ ~`-t~72|', [scasp_verbose:print_goal(Goal)]), nl],
139 print_stack(Stack).
145print_stack(Stack) -->
146 { reverse(Stack, RevStack) },
147 print_stack(RevStack, 4).
148
149print_stack([], _) -->
150 [].
151print_stack([[]|As],I) -->
152 !,
153 { I1 is I - 4 },
154 print_stack(As, I1).
155print_stack([goal_origin(A, _)|As],I) -->
156 !,
157 ['~t~*|'-[I]], goal(A), [ nl ],
158 { I1 is I + 4 },
159 print_stack(As,I1).
160print_stack([A|As],I) -->
161 ['~t~*|'-[I]], goal(A), [ nl ],
162 { I1 is I + 4 },
163 print_stack(As,I1).
164
165eq_goals(Goal, PrevGoal) -->
166 [ '(Goal '-[] ], goal(Goal), [ ' == '-[] ], goal(PrevGoal), [')'-[]].
167
168curr_prev_goals(Goal, NegGoal) -->
169 [ nl,
170 ' Current call: '-[] ], goal(Goal), [ nl,
171 ' Previous call: '-[] ], goal(NegGoal).
172
173goal(Goal) -->
174 [ ansi(code, '~@', [scasp_verbose:print_goal(Goal)]) ].
175
176
177 180
181options(Values) -->
182 sequence(opt, [', '-[]], Values).
183
184opt(Name) -->
185 { atom_length(Name, 1) },
186 !,
187 [ ansi(code, '-~w', [Name]) ].
188opt(Name) -->
189 [ ansi(code, '--~w', [Name]) ].
190
191list(Values) -->
192 sequence(code, [', '-[]], Values).
193
194code(Value) -->
195 [ ansi(code, '~w', [Value]) ]