1use std::sync::Arc;
4
5use sim_kernel::{
6 Cx, DefaultFactory, EagerPolicy, Error, Expr, NumberLiteral, QuoteMode, Result, ShapeMatch,
7 ShapeMatchObject, Symbol, Value, capability::control_prompt_capability,
8 logic_db_write_capability,
9};
10use sim_lib_logic::{
11 LogicConfig, LogicDb,
12 builtins::{BuiltinTable, tabling_memo_binding},
13};
14use sim_lib_standard_core::{
15 MatrixRunReport, MatrixRunner, SourceConformanceCase, SourceObservation,
16};
17
18use crate::conformance_all_solutions::{
19 run_bagof_empty_case, run_bagof_groups_case, run_findall_duplicates_case, run_setof_sorted_case,
20};
21use crate::{install_prolog_lib, prolog_conformance_case_symbol, prolog_matrix_row};
22
23pub fn run_prolog_conformance_case(
25 _cx: &mut Cx,
26 case: &SourceConformanceCase,
27) -> Result<SourceObservation> {
28 if case.symbol == prolog_conformance_case_symbol("unbound-is") {
29 return run_unbound_is_case();
30 }
31 if case.symbol == prolog_conformance_case_symbol("constraint-residual") {
32 return run_constraint_residual_case();
33 }
34 if case.symbol == prolog_conformance_case_symbol("open-list") {
35 return Ok(SourceObservation::Gap {
36 code: Symbol::qualified("prolog", "open-list"),
37 reason: "open and improper lists are outside the closed Expr::List bridge".to_owned(),
38 });
39 }
40 let got = if case.symbol == prolog_conformance_case_symbol("fact") {
41 run_fact_case()?
42 } else if case.symbol == prolog_conformance_case_symbol("rule") {
43 run_rule_case()?
44 } else if case.symbol == prolog_conformance_case_symbol("query") {
45 run_query_case()?
46 } else if case.symbol == prolog_conformance_case_symbol("cut") {
47 run_cut_case()?
48 } else if case.symbol == prolog_conformance_case_symbol("is-promote") {
49 run_is_promote_case()?
50 } else if case.symbol == prolog_conformance_case_symbol("cmp-cross-domain") {
51 run_cmp_cross_domain_case()?
52 } else if case.symbol == prolog_conformance_case_symbol("cmp-false") {
53 run_cmp_false_case()?
54 } else if case.symbol == prolog_conformance_case_symbol("list-member") {
55 run_list_member_case()?
56 } else if case.symbol == prolog_conformance_case_symbol("list-append") {
57 run_list_append_case()?
58 } else if case.symbol == prolog_conformance_case_symbol("findall-duplicates") {
59 run_findall_duplicates_case()?
60 } else if case.symbol == prolog_conformance_case_symbol("bagof-groups") {
61 run_bagof_groups_case()?
62 } else if case.symbol == prolog_conformance_case_symbol("setof-sorted") {
63 run_setof_sorted_case()?
64 } else if case.symbol == prolog_conformance_case_symbol("bagof-empty") {
65 run_bagof_empty_case()?
66 } else if case.symbol == prolog_conformance_case_symbol("constraint-entailed") {
67 run_constraint_entailed_case()?
68 } else if case.symbol == prolog_conformance_case_symbol("constraint-disentailed") {
69 run_constraint_disentailed_case()?
70 } else if case.symbol == prolog_conformance_case_symbol("tabling-left-recursive-path") {
71 run_tabling_demo_case()?
72 } else {
73 return Err(Error::Eval(format!(
74 "unsupported prolog conformance case {}",
75 case.symbol
76 )));
77 };
78 Ok(SourceObservation::LowersTo(got))
79}
80
81pub fn run_prolog_matrix_row(cx: &mut Cx) -> Result<MatrixRunReport> {
83 let row = prolog_matrix_row();
84 let report = MatrixRunner::run_row(cx, &row, run_prolog_conformance_case);
85 report.publish_claims(cx)?;
86 Ok(report)
87}
88
89fn run_fact_case() -> Result<String> {
90 let mut cx = prolog_case_cx()?;
91 assert_clause(&mut cx, fact("color", vec![symbol("red")]))?;
92 let answers = query_all(&mut cx, goal("color", vec![symbol("red")]), 4)?;
93 Ok(format!("prolog:fact answers={}", answers.len()))
94}
95
96fn run_rule_case() -> Result<String> {
97 let mut cx = prolog_case_cx()?;
98 assert_clause(&mut cx, fact("color", vec![symbol("red")]))?;
99 assert_clause(
100 &mut cx,
101 rule(
102 goal("painted", vec![local("x")]),
103 vec![goal("color", vec![local("x")])],
104 ),
105 )?;
106 let answers = query_all(&mut cx, goal("painted", vec![symbol("red")]), 4)?;
107 Ok(format!("prolog:rule answers={}", answers.len()))
108}
109
110fn run_query_case() -> Result<String> {
111 let mut cx = prolog_case_cx()?;
112 assert_clause(&mut cx, fact("color", vec![symbol("red")]))?;
113 assert_clause(&mut cx, fact("color", vec![symbol("green")]))?;
114 let answers = query_all(&mut cx, goal("color", vec![local("x")]), 4)?;
115 Ok(format!("prolog:query answers={}", answers.len()))
116}
117
118fn run_cut_case() -> Result<String> {
119 let mut cx = prolog_case_cx()?;
120 assert_clause(&mut cx, fact("color", vec![symbol("red")]))?;
121 assert_clause(&mut cx, fact("color", vec![symbol("green")]))?;
122 assert_clause(
123 &mut cx,
124 rule(
125 goal("first-color", vec![local("x")]),
126 vec![goal("color", vec![local("x")]), cut()],
127 ),
128 )?;
129 let answers = query_all(&mut cx, goal("first-color", vec![local("shade")]), 4)?;
130 let first = answers
131 .first()
132 .and_then(|answer| binding_expr(answer, "shade"))
133 .map(|expr| expr_label(&expr))
134 .unwrap_or_else(|| "none".to_owned());
135 Ok(format!(
136 "prolog:cut answers={} first={first}",
137 answers.len()
138 ))
139}
140
141fn run_is_promote_case() -> Result<String> {
142 let mut cx = prolog_case_cx()?;
143 let answers = query_all(
144 &mut cx,
145 goal(
146 "is",
147 vec![
148 local("x"),
149 Expr::List(vec![symbol("+"), number("1"), number_in("f64", "0.5")]),
150 ],
151 ),
152 4,
153 )?;
154 let x = answers
155 .first()
156 .and_then(|answer| binding_expr(answer, "x"))
157 .map(|expr| expr_label(&expr))
158 .unwrap_or_else(|| "none".to_owned());
159 Ok(format!(
160 "prolog:is organ=numbers/arith answers={} x={x}",
161 answers.len()
162 ))
163}
164
165fn run_cmp_cross_domain_case() -> Result<String> {
166 let mut cx = prolog_case_cx()?;
167 let answers = query_all(
168 &mut cx,
169 goal("=:=", vec![number("2"), number_in("f64", "2.0")]),
170 4,
171 )?;
172 Ok(format!(
173 "prolog:compare organ=numbers/arith answers={}",
174 answers.len()
175 ))
176}
177
178fn run_cmp_false_case() -> Result<String> {
179 let mut cx = prolog_case_cx()?;
180 let answers = query_all(&mut cx, goal("<", vec![number("3"), number("2")]), 4)?;
181 Ok(format!("prolog:compare answers={}", answers.len()))
182}
183
184fn run_constraint_entailed_case() -> Result<String> {
185 let mut cx = prolog_case_cx()?;
186 let answers = query_all(&mut cx, goal("#=", vec![number("2"), number("2")]), 4)?;
187 Ok(format!(
188 "prolog:constraint organ=control relation=#= verdict=entailed answers={}",
189 answers.len()
190 ))
191}
192
193fn run_constraint_disentailed_case() -> Result<String> {
194 let mut cx = prolog_case_cx()?;
195 let answers = query_all(&mut cx, goal("#<", vec![number("3"), number("2")]), 4)?;
196 Ok(format!(
197 "prolog:constraint organ=control relation=#< verdict=disentailed answers={}",
198 answers.len()
199 ))
200}
201
202fn run_tabling_demo_case() -> Result<String> {
203 let mut cx = prolog_case_cx()?;
204 let mut table = BuiltinTable::standard();
205 table.register(tabling_memo_binding(Symbol::new("path")));
206 let answers = sim_lib_logic::query_all_with_builtins(
207 &mut cx,
208 &left_recursive_path_db()?,
209 &LogicConfig::default(),
210 goal("path", vec![symbol("a"), local("Y")]),
211 Some(8),
212 table,
213 )?;
214 let ys = answers
215 .iter()
216 .filter_map(|answer| binding_expr_from_match(answer, "Y"))
217 .map(|expr| expr_label(&expr))
218 .collect::<Vec<_>>()
219 .join(",");
220 Ok(format!(
221 "prolog:tabling organ=sequence answers={} ys={ys}",
222 answers.len()
223 ))
224}
225
226fn run_list_member_case() -> Result<String> {
227 let mut cx = prolog_case_cx()?;
228 let answers = query_all(
229 &mut cx,
230 goal(
231 "member",
232 vec![
233 local("x"),
234 list(vec![symbol("a"), symbol("b"), symbol("c")]),
235 ],
236 ),
237 4,
238 )?;
239 let xs = answers
240 .iter()
241 .filter_map(|answer| binding_expr(answer, "x"))
242 .map(|expr| expr_label(&expr))
243 .collect::<Vec<_>>()
244 .join(",");
245 Ok(format!(
246 "prolog:member organ=sequence answers={} xs={xs}",
247 answers.len()
248 ))
249}
250
251fn run_list_append_case() -> Result<String> {
252 let mut cx = prolog_case_cx()?;
253 let answers = query_all(
254 &mut cx,
255 goal(
256 "append",
257 vec![
258 list(vec![symbol("a")]),
259 list(vec![symbol("b"), symbol("c")]),
260 local("xs"),
261 ],
262 ),
263 4,
264 )?;
265 let xs = answers
266 .first()
267 .and_then(|answer| binding_expr(answer, "xs"))
268 .map(|expr| expr_label(&expr))
269 .unwrap_or_else(|| "none".to_owned());
270 Ok(format!(
271 "prolog:append organ=sequence answers={} xs={xs}",
272 answers.len()
273 ))
274}
275
276fn run_unbound_is_case() -> Result<SourceObservation> {
277 let mut cx = prolog_case_cx()?;
278 let result = query_all(
279 &mut cx,
280 goal(
281 "is",
282 vec![
283 local("x"),
284 Expr::List(vec![symbol("+"), local("y"), number("1")]),
285 ],
286 ),
287 4,
288 );
289 match result {
290 Err(err) if err.to_string().contains("right-hand side must be ground") => {
291 Ok(SourceObservation::Gap {
292 code: Symbol::qualified("prolog", "unbound-arithmetic"),
293 reason: "is/2 requires the right side to be ground and evaluable".to_owned(),
294 })
295 }
296 Err(err) => Err(err),
297 Ok(answers) => Err(Error::Eval(format!(
298 "unbound-is unexpectedly produced {} answers",
299 answers.len()
300 ))),
301 }
302}
303
304fn run_constraint_residual_case() -> Result<SourceObservation> {
305 let mut cx = prolog_case_cx()?;
306 let result = query_all(&mut cx, goal("dif", vec![local("x"), number("1")]), 4);
307 match result {
308 Err(err)
309 if err
310 .to_string()
311 .contains("residual constraint demand suspended") =>
312 {
313 Ok(SourceObservation::Gap {
314 code: Symbol::qualified("prolog", "residual-constraint"),
315 reason: "residual constraint demand is suspended on the control ledger".to_owned(),
316 })
317 }
318 Err(err) => Err(err),
319 Ok(answers) => Err(Error::Eval(format!(
320 "constraint-residual unexpectedly produced {} answers",
321 answers.len()
322 ))),
323 }
324}
325
326fn left_recursive_path_db() -> Result<LogicDb> {
327 let mut db = LogicDb::new();
328 db.assert_clause_expr(rule(
329 goal("path", vec![local("X"), local("Y")]),
330 vec![
331 goal("path", vec![local("X"), local("Z")]),
332 goal("edge", vec![local("Z"), local("Y")]),
333 ],
334 ))?;
335 db.assert_clause_expr(rule(
336 goal("path", vec![local("X"), local("Y")]),
337 vec![goal("edge", vec![local("X"), local("Y")])],
338 ))?;
339 db.assert_clause_expr(fact("edge", vec![symbol("a"), symbol("b")]))?;
340 db.assert_clause_expr(fact("edge", vec![symbol("b"), symbol("c")]))?;
341 Ok(db)
342}
343
344pub(crate) fn prolog_case_cx() -> Result<Cx> {
345 let mut cx = Cx::new(Arc::new(EagerPolicy), Arc::new(DefaultFactory));
346 cx.load_lib(&sim_lib_numbers_arith::NumbersArithmeticLib::new())?;
347 cx.load_lib(&sim_lib_numbers_i64::I64NumbersLib::new())?;
348 cx.load_lib(&sim_lib_numbers_f64::F64NumbersLib::new())?;
349 sim_lib_control::install_control_policy(&mut cx);
350 install_prolog_lib(&mut cx)?;
351 cx.grant(logic_db_write_capability());
352 cx.grant(control_prompt_capability());
353 Ok(cx)
354}
355
356fn quote(expr: Expr) -> Expr {
357 Expr::Quote {
358 mode: QuoteMode::Quote,
359 expr: Box::new(expr),
360 }
361}
362
363pub(crate) fn symbol(name: &str) -> Expr {
364 Expr::Symbol(Symbol::new(name))
365}
366
367pub(crate) fn local(name: &str) -> Expr {
368 Expr::Local(Symbol::new(name))
369}
370
371fn number(text: &str) -> Expr {
372 number_in("i64", text)
373}
374
375fn number_in(domain: &str, text: &str) -> Expr {
376 Expr::Number(NumberLiteral {
377 domain: Symbol::qualified("numbers", domain),
378 canonical: text.to_owned(),
379 })
380}
381
382pub(crate) fn list(items: Vec<Expr>) -> Expr {
383 Expr::List(items)
384}
385
386pub(crate) fn fact(name: &str, args: Vec<Expr>) -> Expr {
387 Expr::List(vec![
388 symbol("fact"),
389 Expr::List(std::iter::once(symbol(name)).chain(args).collect()),
390 ])
391}
392
393fn rule(head: Expr, body: Vec<Expr>) -> Expr {
394 Expr::List(vec![symbol("rule"), head, Expr::List(body)])
395}
396
397pub(crate) fn goal(name: &str, args: Vec<Expr>) -> Expr {
398 Expr::List(std::iter::once(symbol(name)).chain(args).collect())
399}
400
401fn cut() -> Expr {
402 symbol("!")
403}
404
405pub(crate) fn assert_clause(cx: &mut Cx, clause: Expr) -> Result<()> {
406 let assert_fn = cx.resolve_function(&Symbol::qualified("prolog", "assert!"))?;
407 cx.call_exprs(assert_fn, vec![quote(clause)])?;
408 Ok(())
409}
410
411pub(crate) fn query_all(cx: &mut Cx, goal_expr: Expr, limit: usize) -> Result<Vec<Value>> {
412 let query_all_fn = cx.resolve_function(&Symbol::qualified("prolog", "query/all"))?;
413 cx.call_exprs(
414 query_all_fn,
415 vec![
416 quote(goal_expr),
417 Expr::Symbol(Symbol::new(":limit")),
418 number(&limit.to_string()),
419 ],
420 )?
421 .object()
422 .as_list()
423 .ok_or(Error::TypeMismatch {
424 expected: "prolog answer list",
425 found: "non-list",
426 })?
427 .to_vec(cx, Some(limit))
428}
429
430pub(crate) fn binding_expr(answer: &Value, name: &str) -> Option<Expr> {
431 let symbol = Symbol::new(name);
432 answer
433 .object()
434 .downcast_ref::<ShapeMatchObject>()
435 .and_then(|matched| {
436 matched
437 .matched()
438 .captures
439 .exprs()
440 .iter()
441 .find_map(|(captured, expr)| (captured == &symbol).then(|| expr.clone()))
442 })
443}
444
445fn binding_expr_from_match(answer: &ShapeMatch, name: &str) -> Option<Expr> {
446 let symbol = Symbol::new(name);
447 answer
448 .captures
449 .exprs()
450 .iter()
451 .find_map(|(captured, expr)| (captured == &symbol).then(|| expr.clone()))
452}
453
454pub(crate) fn expr_label(expr: &Expr) -> String {
455 match expr {
456 Expr::Symbol(symbol) => symbol.to_string(),
457 Expr::Number(number) => number.canonical.clone(),
458 Expr::List(items) => {
459 let labels = items.iter().map(expr_label).collect::<Vec<_>>().join(" ");
460 format!("({labels})")
461 }
462 other => format!("{other:?}"),
463 }
464}
465
466#[cfg(test)]
467mod tests {
468 use sim_kernel::{ClaimPattern, Ref, Symbol, testing::bare_cx as cx};
469 use sim_lib_standard_core::{standard_test_capability, standard_test_result_predicate};
470
471 use super::*;
472 use crate::prolog_profile_symbol;
473
474 #[test]
475 fn prolog_matrix_row_runner_reports_all_current_cases() {
476 let mut cx = cx();
477 cx.grant(standard_test_capability());
478
479 let report = run_prolog_matrix_row(&mut cx).unwrap();
480
481 assert_eq!(report.cells.len(), 19);
482 assert_eq!(report.pass_count(), 16);
483 assert_eq!(report.gap_count(), 3);
484 assert_eq!(report.fail_count(), 0);
485 assert_eq!(report.language_fidelity(&Symbol::new("prolog")), Some(1.0));
486 let claims = cx.query_facts(prolog_profile_result_claims()).unwrap();
487 assert_eq!(claims.len(), 19);
488 }
489
490 fn prolog_profile_result_claims() -> ClaimPattern {
491 ClaimPattern {
492 subject: Some(Ref::Symbol(prolog_profile_symbol())),
493 predicate: Some(standard_test_result_predicate()),
494 object: None,
495 include_revoked: false,
496 }
497 }
498}