seam-lang 2.0.0

package/examples/riemann-hypothesis.pl

@@ -0,0 +1,110 @@
+% Riemann hypothesis, as a finite seam check.
+%
+% This example does not prove the Riemann hypothesis.  It models the
+% finite statement: every non-trivial zero in the local catalogue has
+% real part 0.5.  A real proof would have to cover all non-trivial zeros,
+% not only the facts listed here.
+
+% Print the finite check summary and the per-zero audit rows.
+materialize(rh, 2).
+materialize(zero_check, 3).
+
+% --- Sample zero catalogue -------------------------------------------------
+%
+% The three z* entries stand for catalogued non-trivial zeros of the
+% Riemann zeta function.  The t* entry is a trivial zero, included to show
+% that the rules below deliberately exclude it from the RH check.
+
+zeta_zero(z1).
+real_part(z1, 0.5).
+imaginary_part(z1, 14.134725).
+source(z1, "first catalogued non-trivial zero in this example").
+
+zeta_zero(z2).
+real_part(z2, 0.5).
+imaginary_part(z2, 21.02204).
+source(z2, "second catalogued non-trivial zero in this example").
+
+zeta_zero(z3).
+real_part(z3, 0.5).
+imaginary_part(z3, 25.010858).
+source(z3, "third catalogued non-trivial zero in this example").
+
+zeta_zero(t1).
+trivial_zero(t1).
+real_part(t1, -2).
+imaginary_part(t1, 0).
+source(t1, "trivial zero, outside the non-trivial RH check").
+
+% --- Classification rules --------------------------------------------------
+%
+% A non-trivial zero is one of the catalogued zeta zeros that lies in the
+% critical strip 0 < real part < 1 and is not explicitly marked as trivial.
+
+in_critical_strip(Zero) :-
+  real_part(Zero, Real),
+  gt(Real, 0),
+  lt(Real, 1).
+
+non_trivial_zero(Zero) :-
+  zeta_zero(Zero),
+  in_critical_strip(Zero),
+  not(trivial_zero(Zero)).
+
+% The RH condition for one zero: its real part is exactly one half.
+
+on_critical_line(Zero) :-
+  non_trivial_zero(Zero),
+  real_part(Zero, 0.5).
+
+% A finite counterexample would be a catalogued non-trivial zero whose real
+% part is not one half.
+
+off_critical_line(Zero) :-
+  non_trivial_zero(Zero),
+  real_part(Zero, Real),
+  neq(Real, 0.5).
+
+catalog_has(non_trivial_zero) :-
+  non_trivial_zero(_somezero).
+
+counterexample_found(yes) :-
+  off_critical_line(_zero).
+
+% The finite catalogue supports RH exactly when it contains at least one
+% non-trivial zero and no catalogued counterexample.
+
+finite_catalog_supports_rh(yes) :-
+  catalog_has(non_trivial_zero),
+  not(counterexample_found(yes)).
+
+% --- Materialized audit output --------------------------------------------
+
+% These tiny support facts make the summary rows derived output rather than
+% source facts; seam intentionally does not reprint source facts.
+
+summary_row(scope, finite_catalog_only).
+summary_row(caveat, "finite catalogue evidence only; this is not a proof of RH").
+
+rh(Key, Value) :-
+  summary_row(Key, Value).
+
+rh(status, no_counterexample_in_catalog) :-
+  finite_catalog_supports_rh(yes).
+
+rh(status, counterexample_in_catalog) :-
+  counterexample_found(yes).
+
+zero_check(Zero, real_part, Real) :-
+  non_trivial_zero(Zero),
+  real_part(Zero, Real).
+
+zero_check(Zero, imaginary_part, Imaginary) :-
+  non_trivial_zero(Zero),
+  imaginary_part(Zero, Imaginary).
+
+zero_check(Zero, classification, on_critical_line) :-
+  on_critical_line(Zero).
+
+zero_check(Zero, classification, off_critical_line) :-
+  off_critical_line(Zero).

package/examples/route-planning.pl

@@ -0,0 +1,33 @@
+% Route planning with explicit route terms.
+%
+% This is the Seam version of the classic Paris-to-Nantes path example: the
+% facts describe one-way road links, and `path/2` derives both the endpoint pair
+% and a structured `go(..., ..., ...)` plan.  The plan is ordinary data, so the
+% route can be inspected, stored, or used by later rules.
+
+materialize(route_to_nantes, 2).
+table(path, 2).
+mode(path, 2, [in, out]).
+
+oneway(paris, orleans).
+oneway(paris, chartres).
+oneway(paris, amiens).
+oneway(orleans, blois).
+oneway(orleans, bourges).
+oneway(blois, tours).
+oneway(chartres, lemans).
+oneway(lemans, angers).
+oneway(lemans, tours).
+oneway(angers, nantes).
+
+% A direct edge is a one-step plan.
+path([A, B], go(A, B, goal)) :-
+  oneway(A, B).
+
+% A longer path prepends one edge to the remaining plan.
+path([A, C], go(A, B, Rest)) :-
+  oneway(A, B),
+  path([B, C], Rest).
+
+route_to_nantes(From, Plan) :-
+  path([From, nantes], Plan).

package/examples/sat-solver-dpll.pl

@@ -0,0 +1,88 @@
+% DPLL-style SAT solving for a small CNF formula.
+%
+% The example keeps the solver itself in Seam.  It recursively assigns
+% variables in a fixed order, prunes a branch as soon as any clause is already
+% impossible, and accepts a complete assignment when every clause is satisfied.
+% aggregate_min/5 is then used only to choose one canonical satisfying model.
+
+materialize(satModel, 1).
+materialize(satValue, 2).
+materialize(satClauseStatus, 2).
+materialize(satConclusion, 2).
+
+% CNF formula:
+%   (a or b)
+%   (not a or c)
+%   (not b or c)
+%   (not c or d)
+%   (c or not d)
+variable_order([a, b, c, d]).
+clause(c1, [pos(a), pos(b)]).
+clause(c2, [neg(a), pos(c)]).
+clause(c3, [neg(b), pos(c)]).
+clause(c4, [neg(c), pos(d)]).
+clause(c5, [pos(c), neg(d)]).
+
+bool(false).
+bool(true).
+bit(false, 0).
+bit(true, 1).
+
+% Look up a variable inside a partial or complete assignment represented as a
+% list of bind(Name, Bool) terms.
+lookup_bool(Name, [bind(Name, Value) | _], Value).
+lookup_bool(Name, [bind(_, _) | Rest], Value) :- lookup_bool(Name, Rest, Value).
+
+literal_true(pos(Var), Assignment) :- lookup_bool(Var, Assignment, true).
+literal_true(neg(Var), Assignment) :- lookup_bool(Var, Assignment, false).
+literal_false(pos(Var), Assignment) :- lookup_bool(Var, Assignment, false).
+literal_false(neg(Var), Assignment) :- lookup_bool(Var, Assignment, true).
+
+clause_satisfied(Assignment, Clause_name) :-
+  clause(Clause_name, Literals),
+  member(Literal, Literals),
+  literal_true(Literal, Assignment).
+
+% A partial branch is impossible when every literal in a clause is already false.
+% Unassigned literals keep the branch alive, just as in DPLL.
+clause_impossible(Assignment, Clause_name) :-
+  clause(Clause_name, Literals),
+  forall(member(Literal, Literals), literal_false(Literal, Assignment)).
+partial_consistent(Assignment) :- not((clause(Name, _), clause_impossible(Assignment, Name))).
+complete_model(Assignment) :- forall(clause(Name, _), clause_satisfied(Assignment, Name)).
+
+% Recursive DPLL search: choose a truth value, prune if inconsistent, then
+% continue with the remaining variables.
+dpll([], Assignment, Assignment) :- complete_model(Assignment).
+dpll([Var | Rest], Partial, Model) :-
+  bool(Value),
+  partial_consistent([bind(Var, Value) | Partial]),
+  dpll(Rest, [bind(Var, Value) | Partial], Model).
+
+satisfying_model(Model) :- variable_order(Vars), dpll(Vars, [], Model).
+
+% Rank models so the materialized output shows one deterministic answer.  The
+% model list is in reverse decision order because each decision is pushed onto
+% the front during recursion.
+model_rank(Model, Rank) :-
+  lookup_bool(a, Model, A), bit(A, Abit),
+  lookup_bool(b, Model, B), bit(B, Bbit),
+  lookup_bool(c, Model, C), bit(C, Cbit),
+  lookup_bool(d, Model, D), bit(D, Dbit),
+  mul(Abit, 8, Arank),
+  mul(Bbit, 4, Brank),
+  mul(Cbit, 2, Crank),
+  add(Arank, Brank, Ab),
+  add(Crank, Dbit, Cd),
+  add(Ab, Cd, Rank).
+
+best_model(Model, Rank) :-
+  aggregate_min(Candidate_rank, Candidate_model,
+    (satisfying_model(Candidate_model), model_rank(Candidate_model, Candidate_rank)),
+    Rank, Model).
+
+satModel(Model) :- best_model(Model, _).
+satValue(Var, Value) :- best_model(Model, _), lookup_bool(Var, Model, Value).
+satClauseStatus(Clause, satisfied) :- best_model(Model, _), clause_satisfied(Model, Clause).
+satConclusion(case, "DPLL finds a satisfying assignment after pruning clauses that become impossible") :-
+  best_model(_, _).

package/examples/security-incident-correlation.pl

@@ -0,0 +1,69 @@
+% Representative example: security incident correlation.
+%
+% The rules correlate endpoint, identity, vulnerability, and threat-intelligence
+% signals into an escalation decision with concise reason relations.
+
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(type, 2).
+materialize(status, 2).
+materialize(reason, 2).
+
+% Program structure: facts set up the scenario, and rules derive the materialized conclusions.
+incident(inc42).
+incident(inc43).
+
+asset(endpoint23, criticality, high).
+asset(endpoint77, criticality, low).
+
+assigned_user(endpoint23, user_alice).
+assigned_user(endpoint77, user_bob).
+
+privileged_user(user_alice).
+
+alert(inc42, endpoint, endpoint23).
+alert(inc42, suspicious_login, user_alice).
+alert(inc42, malware_hash, hash_redline).
+alert(inc42, outbound_ip, ip_203_0_113_17).
+
+alert(inc43, endpoint, endpoint77).
+alert(inc43, suspicious_login, user_bob).
+alert(inc43, outbound_ip, ip_198_51_100_42).
+
+vulnerability(endpoint23, cve_critical_rce).
+threat_intel(ip_203_0_113_17, command_and_control).
+
+% Derivation rules: each rule below contributes one logical step toward the displayed results.
+critical_asset(Endpoint) :-
+  asset(Endpoint, criticality, high).
+
+credential_abuse(Incident) :-
+  alert(Incident, suspicious_login, User),
+  privileged_user(User).
+
+malware_on_critical_asset(Incident) :-
+  alert(Incident, endpoint, Endpoint),
+  alert(Incident, malware_hash, _hash),
+  critical_asset(Endpoint).
+
+c2_contact(Incident) :-
+  alert(Incident, outbound_ip, Ip),
+  threat_intel(Ip, command_and_control).
+
+exploitable_endpoint(Incident) :-
+  alert(Incident, endpoint, Endpoint),
+  vulnerability(Endpoint, cve_critical_rce).
+
+confirmed_compromise(Incident) :-
+  credential_abuse(Incident),
+  malware_on_critical_asset(Incident),
+  c2_contact(Incident),
+  exploitable_endpoint(Incident).
+
+type(Incident, confirmed_compromise) :-
+  confirmed_compromise(Incident).
+
+status(Incident, escalate_to_incident_response) :-
+  confirmed_compromise(Incident).
+
+reason(Incident, "privileged credential abuse, malware on a critical endpoint, C2 contact, and exploitable RCE are correlated") :-
+  confirmed_compromise(Incident).

package/examples/send-more-money.pl

@@ -0,0 +1,71 @@
+% Cryptarithm search for SEND + MORE = MONEY.
+%
+% The solver assigns distinct decimal digits to letters while enforcing the
+% column-by-column carries.  Rather than generate all digit assignments first,
+% each column constraint is applied as soon as its letters are chosen.
+materialize(cryptarithm_answer, 2).
+
+% The search domain is a shrinking digit list threaded through select/3 calls.
+all_digits([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]).
+
+send_more_money(solution(S, E, N, D, M, O, R, Y)) :-
+  all_digits(Digits),
+  eq(M, 1),
+  eq(O, 0),
+  select(M, Digits, D0),
+  select(O, D0, D1),
+
+  select(D, D1, D2),
+  select(E, D2, D3),
+  add(D, E, Onessum),
+  mod(Onessum, 10, Y),
+  div(Onessum, 10, Carry1),
+  select(Y, D3, D4),
+
+  select(N, D4, D5),
+  select(R, D5, D6),
+  add(N, R, Tenspartial),
+  add(Tenspartial, Carry1, Tenssum),
+  mod(Tenssum, 10, E),
+  div(Tenssum, 10, Carry2),
+
+  add(E, O, Hundredspartial),
+  add(Hundredspartial, Carry2, Hundredssum),
+  mod(Hundredssum, 10, N),
+  div(Hundredssum, 10, Carry3),
+
+  select(S, D6, _d7),
+  neq(S, 0),
+  add(S, M, Thousandspartial),
+  add(Thousandspartial, Carry3, Thousandssum),
+  mod(Thousandssum, 10, O),
+  div(Thousandssum, 10, M).
+
+% Number constructors are used only for readable output after a solution is found.
+number4(A, B, C, D, Value) :-
+  mul(A, 1000, Apart),
+  mul(B, 100, Bpart),
+  mul(C, 10, Cpart),
+  add(Apart, Bpart, Ab),
+  add(Ab, Cpart, Abc),
+  add(Abc, D, Value).
+
+number5(A, B, C, D, E, Value) :-
+  mul(A, 10000, Apart),
+  mul(B, 1000, Bpart),
+  mul(C, 100, Cpart),
+  mul(D, 10, Dpart),
+  add(Apart, Bpart, Ab),
+  add(Ab, Cpart, Abc),
+  add(Abc, Dpart, Abcd),
+  add(Abcd, E, Value).
+
+cryptarithm_answer(assignments, solution(S, E, N, D, M, O, R, Y)) :-
+  send_more_money(solution(S, E, N, D, M, O, R, Y)).
+cryptarithm_answer(equation, equation(Send, More, Money)) :-
+  send_more_money(solution(S, E, N, D, M, O, R, Y)),
+  number4(S, E, N, D, Send),
+  number4(M, O, R, E, More),
+  number5(M, O, N, E, Y, Money).
+cryptarithm_answer(solution_count, Count) :-
+  countall(send_more_money(_solution), Count).

package/examples/service-impact.pl

@@ -0,0 +1,41 @@
+% Practical cyclic recursion: incident impact analysis for a service dependency graph.
+% The payment stack has a real-world feedback cycle: payment_service calls
+% fraud_service, fraud_service calls risk_rules, and risk_rules calls payment_service
+% for authorization data. A payment outage should still produce a finite impact set.
+
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(impactedByFailureOf, 2).
+materialize(status, 2).
+materialize(businessFunctionAtRisk, 2).
+
+% Program structure: facts set up the scenario, and rules derive the materialized conclusions.
+depends_on(web_store, checkout_api).
+depends_on(mobile_app, checkout_api).
+depends_on(checkout_api, payment_service).
+depends_on(checkout_api, inventory_service).
+depends_on(payment_service, fraud_service).
+depends_on(fraud_service, risk_rules).
+depends_on(risk_rules, payment_service).
+depends_on(inventory_service, stock_db).
+depends_on(stock_db, inventory_service).
+
+business_function(place_order, web_store).
+business_function(mobile_checkout, mobile_app).
+business_function(collect_payment, payment_service).
+business_function(screen_fraud, fraud_service).
+business_function(show_stock, inventory_service).
+
+failed(payment_service).
+
+% Derivation rules: each rule below contributes one logical step toward the displayed results.
+impacted(Service, Failed) :- depends_on(Service, Failed).
+impacted(Service, Failed) :- depends_on(Service, Dependency), impacted(Dependency, Failed).
+
+affected(Service) :- failed(Failed), impacted(Service, Failed).
+affected(Service) :- failed(Service).
+
+affected_function(Function) :- business_function(Function, Service), affected(Service).
+
+impactedByFailureOf(Service, Failed) :- failed(Failed), impacted(Service, Failed).
+status(Service, failed) :- failed(Service).
+businessFunctionAtRisk(Function, true) :- affected_function(Function).

package/examples/shoelace-polygon-area.pl

@@ -0,0 +1,22 @@
+% Polygon area by the shoelace formula.
+%
+% The input polygon is the same closed polygon shape used by the source example:
+% the final point repeats the first point.  Each recursive step consumes one
+% adjacent pair and contributes `(x1*y2 - y1*x2) / 2` to the oriented area.
+
+materialize(polygon_area, 2).
+
+sample_polygon([[3, 2], [6, 2], [7, 6], [4, 6], [5, 5], [5, 3], [3, 2]]).
+
+area([_point], 0).
+area([[A, B], [C, D]|Rest], Total) :-
+  area([[C, D]|Rest], Subtotal),
+  mul(A, D, Ad),
+  mul(B, C, Bc),
+  sub(Ad, Bc, Cross),
+  div(Cross, 2.0, Half),
+  add(Half, Subtotal, Total).
+
+polygon_area(sample, Area) :-
+  sample_polygon(Points),
+  area(Points, Area).

package/examples/sieve.pl

@@ -0,0 +1,20 @@
+% Prime enumeration inspired by Eyelet input/sieve.pl.
+% The 1000-limit answer matches Eyelet output-swipl/sieve.pl.
+%
+% seam uses the built-in smallest_divisor_from/3 relation to keep the
+% example fast while preserving the same generated prime list.
+
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(primes, 2).
+
+% Program structure: facts set up the scenario, and rules derive the materialized conclusions.
+want_primes(1000).
+
+% Derivation rules: each rule below contributes one logical step toward the displayed results.
+prime_under(Limit, P) :-
+  between(2, Limit, P),
+  smallest_divisor_from(P, 2, P).
+
+primes(Limit, Ps) :-
+  want_primes(Limit),
+  findall(P, prime_under(Limit, P), Ps).

package/examples/skolem-functions.pl

@@ -0,0 +1,52 @@
+% Skolem functional terms in rule heads.
+%
+% A generated resource should be deterministic and collision-free. Use a
+% function symbol whose arguments contain the values that make the resource
+% unique, such as skolem_observation(Patient, Test).
+
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(type, 2).
+materialize(patient, 2).
+materialize(test, 2).
+materialize(value, 2).
+materialize(about, 2).
+materialize(sameInputsSameId, 2).
+materialize(noObservationClash, 2).
+
+% Program structure: facts set up the scenario, and rules derive the materialized conclusions.
+test_result(alice, glucose, 6.8).
+test_result(alice, cholesterol, 4.2).
+test_result(bob, glucose, 5.1).
+
+% Derivation rules: each rule below contributes one logical step toward the displayed results.
+high_glucose(Patient) :-
+  test_result(Patient, glucose, Value),
+  gt(Value, 6.0).
+
+observation_id(Patient, Test, skolem_observation(Patient, Test)) :-
+  test_result(Patient, Test, _value).
+
+type(skolem_observation(Patient, Test), observation) :-
+  test_result(Patient, Test, _value).
+
+patient(skolem_observation(Patient, Test), Patient) :-
+  test_result(Patient, Test, _value).
+
+test(skolem_observation(Patient, Test), Test) :-
+  test_result(Patient, Test, _value).
+
+value(skolem_observation(Patient, Test), Value) :-
+  test_result(Patient, Test, Value).
+
+type(skolem_alert(Patient, glucose), highGlucoseAlert) :-
+  high_glucose(Patient).
+
+about(skolem_alert(Patient, glucose), skolem_observation(Patient, glucose)) :-
+  high_glucose(Patient).
+
+sameInputsSameId(skolemDemo, true) :-
+  eq(skolem_observation(alice, glucose), skolem_observation(alice, glucose)).
+
+noObservationClash(skolemDemo, true) :-
+  neq(skolem_observation(alice, glucose), skolem_observation(alice, cholesterol)),
+  neq(skolem_observation(alice, glucose), skolem_observation(bob, glucose)).

package/examples/socket-age.pl

@@ -0,0 +1,39 @@
+% socket-age.pl
+%
+% A small runnable seam Socket example for age reasoning.
+%
+% The socket facts are ordinary seam data. They document the semantic
+% openings that this rule module expects:
+%
+%   - a patient registry that provides birthDay/2
+%   - a policy source that provides duration/2
+%   - a clock source that provides today/1
+%
+% The plug facts say which concrete providers are connected.
+%
+% Run:
+%   seam socket-age.pl
+
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(ageAbove, 2).
+
+% Program structure: facts set up the scenario, and rules derive the materialized conclusions.
+socket(patient_registry, provides(birthDay_2)).
+socket(policy_source, provides(duration_2)).
+socket(clock_source, provides(today_1)).
+
+plug(test_patients, patient_registry).
+plug(test_policy, policy_source).
+plug(test_clock, clock_source).
+
+birthDay(patH, "1944-08-21").
+duration(check, "P80Y").
+today("2026-05-30").
+
+% Derivation rules: each rule below contributes one logical step toward the displayed results.
+ageAbove(S, A) :-
+    birthDay(S, B),
+    duration(check, A),
+    today(D),
+    difference(D, B, F),
+    gt(F, A).

package/examples/socket-family.pl

@@ -0,0 +1,28 @@
+% socket-family.pl
+%
+% A small runnable seam Socket example.
+%
+% The socket facts below are ordinary seam data. They document the
+% semantic opening: this reasoning module expects a provider for parent/2.
+% The plug fact says which provider is connected.
+%
+% Run:
+%   seam socket-family.pl
+
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(ancestor, 2).
+
+% Program structure: facts set up the scenario, and rules derive the materialized conclusions.
+socket(family_source, provides(parent_2)).
+plug(family_file, family_source).
+
+parent(pat, jan).
+parent(jan, emma).
+
+% Derivation rules: each rule below contributes one logical step toward the displayed results.
+ancestor(X, Y) :-
+    parent(X, Y).
+
+ancestor(X, Z) :-
+    parent(X, Y),
+    ancestor(Y, Z).

package/examples/socrates.pl

@@ -0,0 +1,19 @@
+% Socrates is mortal, adapted from Eyelet's input/socrates.pl.
+%
+% Eyelet uses type('Socrates', 'Man') and a single rule deriving Mortal.
+% seam keeps the same reasoning shape and emits relation facts.
+
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(type, 2).
+materialize(is, 2).
+
+% Program structure: facts set up the scenario, and rules derive the materialized conclusions.
+type(socrates, man).
+
+% Derivation rules: each rule below contributes one logical step toward the displayed results.
+type(X, mortal) :-
+  type(X, man).
+
+
+is(test, true) :-
+  type(socrates, mortal).

package/examples/stable-marriage.pl

@@ -0,0 +1,92 @@
+% Stable-marriage search with explicit blocking-pair detection.
+%
+% matching/1 enumerates one-to-one pairings for four men and four women.  A
+% pairing is stable precisely when no blocking pair exists: two people who would
+% both prefer each other over their assigned partners.
+materialize(stable_marriage_answer, 2).
+
+man(adam).
+man(brian).
+man(cole).
+man(drew).
+
+woman(amy).
+woman(bea).
+woman(cora).
+woman(dana).
+
+rank_man(adam, bea, 1).
+rank_man(adam, amy, 2).
+rank_man(adam, dana, 3).
+rank_man(adam, cora, 4).
+rank_man(brian, amy, 1).
+rank_man(brian, cora, 2).
+rank_man(brian, bea, 3).
+rank_man(brian, dana, 4).
+rank_man(cole, amy, 1).
+rank_man(cole, bea, 2).
+rank_man(cole, dana, 3).
+rank_man(cole, cora, 4).
+rank_man(drew, cora, 1).
+rank_man(drew, dana, 2).
+rank_man(drew, bea, 3).
+rank_man(drew, amy, 4).
+
+rank_woman(amy, cole, 1).
+rank_woman(amy, adam, 2).
+rank_woman(amy, brian, 3).
+rank_woman(amy, drew, 4).
+rank_woman(bea, adam, 1).
+rank_woman(bea, cole, 2).
+rank_woman(bea, drew, 3).
+rank_woman(bea, brian, 4).
+rank_woman(cora, drew, 1).
+rank_woman(cora, brian, 2).
+rank_woman(cora, adam, 3).
+rank_woman(cora, cole, 4).
+rank_woman(dana, brian, 1).
+rank_woman(dana, drew, 2).
+rank_woman(dana, cole, 3).
+rank_woman(dana, adam, 4).
+
+% Permutations give every complete one-to-one matching over the four women.
+perm([], []).
+perm(Items, [X|Rest]) :-
+  select(X, Items, Remaining),
+  perm(Remaining, Rest).
+
+matching([
+  pair(adam, W1),
+  pair(brian, W2),
+  pair(cole, W3),
+  pair(drew, W4)
+]) :-
+  perm([amy, bea, cora, dana], [W1, W2, W3, W4]).
+
+assigned(Matching, Man, Woman) :- member(pair(Man, Woman), Matching).
+
+prefers_man(Man, Candidate, Current) :-
+  rank_man(Man, Candidate, Candidaterank),
+  rank_man(Man, Current, Currentrank),
+  lt(Candidaterank, Currentrank).
+
+prefers_woman(Woman, Candidate, Current) :-
+  rank_woman(Woman, Candidate, Candidaterank),
+  rank_woman(Woman, Current, Currentrank),
+  lt(Candidaterank, Currentrank).
+
+% A blocking pair witnesses instability of a candidate matching.
+blocking_pair(Matching, Man, Woman) :-
+  assigned(Matching, Man, Currentwoman),
+  woman(Woman),
+  neq(Woman, Currentwoman),
+  prefers_man(Man, Woman, Currentwoman),
+  assigned(Matching, Currentman, Woman),
+  prefers_woman(Woman, Man, Currentman).
+
+stable_matching(Matching) :-
+  matching(Matching),
+  not(blocking_pair(Matching, _man, _woman)).
+
+stable_marriage_answer(first_stable_matching, Matching) :- once(stable_matching(Matching)).
+stable_marriage_answer(stable_matching_count, Count) :- countall(stable_matching(_matching), Count).