1:- module(casp_lang_nl,
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(nl, casp_lang_nl).
13
14
15 18
19scasp_message(version(Version)) -->
20 [ 'versie ~w'-[Version] ].
21
23
24scasp_message(source_not_found(Source)) -->
25 ( \+ { access_file(Source, exist) }
26 -> [ 'Invoer bestand '-[] ], code(Source), [ ' bestaat niet'-[] ]
27 ; [ 'Kan invoer bestand '-[] ], code(Source), [ ' niet lezen'-[] ]
28 ).
29scasp_message(no_input_files) -->
30 [ 'Geen invoer gespecificeerd!' ].
31scasp_message(no_query) -->
32 [ 'Het programma bevat geen ?- Query.'-[] ].
33scasp_message(undefined_operator(Op)) -->
34 [ 'clp operator ~p is niet gedefinieerd'-[Op] ].
35scasp_message(at_most_one_of([A,B])) -->
36 ['Opties '], opt(A), [' and '], opt(B),
37 [' gaan niet samen' ].
38scasp_message(at_most_one_of(List)) -->
39 [ 'Maximaal een van de opties '-[] ],
40 options(List),
41 [ ' kan gelijktijdig gebruikt worden.'-[] ].
42scasp_message(opt_dcc_prev_forall) -->
43 [ 'Optie --dcc kan alleen samen met --forall=prev' ].
44scasp_message(opt_incompatible(Opt1, Opt2)) -->
45 [ 'Optie ' ], opt(Opt1), [' gaat niet samen met '], opt(Opt2).
46
48
49scasp_message(failure_calling_negation(Goal)) -->
50 [ 'Negatie van '-[] ], goal(Goal), [ ' faalt'-[] ].
51scasp_message(co_failing_in_negated_loop(Goal, NegGoal)) -->
52 [ 'Co-Failing in a negated loop due to a variant call'-[], nl,
53 '(extension clp-disequality required).'-[]
54 ],
55 curr_prev_goals(Goal, NegGoal).
56scasp_message(variant_loop(Goal, PrevGoal)) -->
57 [ 'Failing in a positive loop due to a variant call (tabling required).'-[]
58 ],
59 curr_prev_goals(Goal, PrevGoal).
60scasp_message(subsumed_loop(Goal, PrevGoal)) -->
61 [ 'Failing in a positive loop due to a subsumed call under clp(q).'-[]
62 ],
63 curr_prev_goals(Goal, PrevGoal).
64scasp_message(pos_loop(fail, Goal, PrevGoal)) -->
65 [ 'Positive loop failing '-[] ],
66 eq_goals(Goal, PrevGoal).
67
68scasp_message(pos_loop(continue, Goal, PrevGoal)) -->
69 [ 'Positive loop continuing '-[] ],
70 eq_goals(Goal, PrevGoal).
71scasp_message(trace_failure(Goal, Stack)) -->
72 print_check_calls_calling(Goal, Stack),
73 [ ansi(warning, 'FAILURE to prove the literal: ', []) ],
74 goal(Goal).
75
76scasp_message(dcc_call(Goal, Stack)) -->
77 [ 'DCC of ' ], goal(Goal),
78 [ ' in ' ], print_stack(Stack).
79scasp_message(dcc_discard(Goal, BodyL)) -->
80 { comma_list(Body, BodyL) },
81 [ 'DCC discards '], goal(Goal),
82 [ ' when checking nmr ~p'-[ dcc(Goal) :- Body ] ].
83
85
86scasp_message(no_models(CPU)) -->
87 [ 'Geen modellen (~3f seconden)'-[CPU] ].
88
89
91
92scasp_message(and) --> [ 'en' ].
93scasp_message(or) --> [ 'of' ].
94scasp_message(not) --> [ 'er is geen bewijs dat' ].
95scasp_message(-) --> [ 'het is niet het geval dat' ].
96scasp_message(implies) --> [ 'omdat' ].
97scasp_message(?) --> [ '?' ].
98scasp_message(proved) --> ['als hierboven aangetoond'].
99scasp_message(chs) --> ['het is aangenomen dat'].
100scasp_message(assume) --> ['we nemen aan dat'].
101scasp_message(holds) --> [' is waar'].
102scasp_message(holds_for) --> [' is waar voor '].
103scasp_message(not_in) --> ['niet zijnde'].
104scasp_message('\u2209'(_,_)) --> ['niet zijnde'].
105scasp_message(neq) --> ['ongelijk aan'].
106scasp_message(_>_) --> ['is groter dan'].
107scasp_message(_>=_) --> ['is groter dan of gelijk aan'].
108scasp_message(_<_) --> ['is kleiner dan'].
109scasp_message(_=<_) --> ['is kleiner dan of gelijk aan'].
110scasp_message(_#=_) --> ['gelijk aan'].
111scasp_message(_#<>_) --> ['ongelijk aan'].
112scasp_message(_#>_) --> ['groter dan'].
113scasp_message(_#>=_) --> ['groter dan of gelijk aan'].
114scasp_message(_#<_) --> ['kleiner dan'].
115scasp_message(_#=<_) --> ['kleiner dan of gelijk aan'].
116scasp_message(global_constraints_hold) -->
117 [ 'Aan alle globale restricties is voldaan' ].
118scasp_message(global_constraint(N)) -->
119 [ 'Aan de globale restrictie nummer ', N, ' is voldaan' ].
120scasp_message(abducible) -->
121 [ 'middels abductie concluderen we dat' ].
122scasp_message(according_to) --> [ 'volgens' ].
123
124
125
126 129
130print_check_calls_calling(Goal, Stack) -->
131 [ansi(bold, '~`-t Calling: ~@ ~`-t~72|', [scasp_verbose:print_goal(Goal)]), nl],
132 print_stack(Stack).
138print_stack(Stack) -->
139 { reverse(Stack, RevStack) },
140 print_stack(RevStack, 4).
141
142print_stack([], _) -->
143 [].
144print_stack([[]|As],I) -->
145 !,
146 { I1 is I - 4 },
147 print_stack(As, I1).
148print_stack([A|As],I) -->
149 ['~t~*|'-[I]], goal(A), [ nl ],
150 { I1 is I + 4 },
151 print_stack(As,I1).
152
153eq_goals(Goal, PrevGoal) -->
154 [ '(Goal '-[] ], goal(Goal), [ ' == '-[] ], goal(PrevGoal), [')'-[]].
155
156curr_prev_goals(Goal, NegGoal) -->
157 [ nl,
158 ' Current call: '-[] ], goal(Goal), [ nl,
159 ' Previous call: '-[] ], goal(NegGoal).
160
161goal(Goal) -->
162 [ ansi(code, '~@', [scasp_verbose:print_goal(Goal)]) ].
163
164
165 168
169options(Values) -->
170 sequence(opt, [', '-[]], Values).
171
172opt(Name) -->
173 { atom_length(Name, 1) },
174 !,
175 [ ansi(code, '-~w', [Name]) ].
176opt(Name) -->
177 [ ansi(code, '--~w', [Name]) ].
178
179list(Values) -->
180 sequence(code, [', '-[]], Values).
181
182code(Value) -->
183 [ ansi(code, '~w', [Value]) ]