seam-lang 2.0.0

package/examples/statistics-summary.pl

@@ -0,0 +1,56 @@
+% Population statistics for a small numeric sample.
+%
+% The sample is the textbook data set [2,4,4,4,5,5,7,9], whose population
+% mean is 5, variance is 4, and standard deviation is 2.
+
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(count, 2).
+materialize(mean, 2).
+materialize(populationVariance, 2).
+materialize(populationStddev, 2).
+
+% The sample is one list fact, which lets recursive list folds demonstrate
+% aggregation without introducing a separate row relation.
+sample(scores, [2.0, 4.0, 4.0, 4.0, 5.0, 5.0, 7.0, 9.0]).
+
+sum([], 0.0).
+% sum/2 and squared_error_sum/3 are recursive folds; the public relations then
+% derive count, mean, population variance, and standard deviation.
+sum([X|Xs], Total) :-
+  sum(Xs, Rest),
+  add(X, Rest, Total).
+
+mean(Name, Mean) :-
+  sample(Name, Values),
+  sum(Values, Total),
+  length(Values, Count),
+  div(Total, Count, Mean).
+
+squared_error_sum([], _mean, 0.0).
+squared_error_sum([X|Xs], Mean, Total) :-
+  sub(X, Mean, Delta),
+  pow(Delta, 2.0, Squared),
+  squared_error_sum(Xs, Mean, Rest),
+  add(Squared, Rest, Total).
+
+population_variance(Name, Variance) :-
+  sample(Name, Values),
+  mean(Name, Mean),
+  squared_error_sum(Values, Mean, Sumsquarederrors),
+  length(Values, Count),
+  div(Sumsquarederrors, Count, Variance).
+
+population_stddev(Name, Stddev) :-
+  population_variance(Name, Variance),
+  pow(Variance, 0.5, Stddev).
+
+count(Name, Count) :-
+  sample(Name, Values),
+  length(Values, Count).
+
+
+populationVariance(Name, Variance) :-
+  population_variance(Name, Variance).
+
+populationStddev(Name, Stddev) :-
+  population_stddev(Name, Stddev).

package/examples/stirling-bell-numbers.pl

@@ -0,0 +1,69 @@
+% Stirling numbers of the second kind and Bell numbers.
+%
+% The Stirling count S(N,K) is computed with the inclusion-exclusion formula
+%   S(N,K) = (1/K!) * sum(I=0..K, (-1)^(K-I) * C(K,I) * I^N)
+% instead of the overlapping two-branch recurrence.  Bell numbers use
+%   B(0) = 1, B(N) = sum(K=0..N-1, C(N-1,K) * B(K)).
+% The table declarations memoize the smaller helper relations used by both formulas.
+materialize(stirling_bell_answer, 2).
+
+table(factorial, 2).
+table(binomial, 3).
+table(stirling2, 3).
+table(bell, 2).
+
+factorial(0, 1).
+factorial(N, Value) :-
+  gt(N, 0),
+  sub(N, 1, N1),
+  factorial(N1, Previous),
+  mul(N, Previous, Value).
+
+binomial(0, 0, 1).
+binomial(N, 0, 1) :- gt(N, 0).
+binomial(N, N, 1) :- gt(N, 0).
+binomial(N, K, Value) :-
+  gt(N, 0),
+  gt(K, 0),
+  lt(K, N),
+  sub(N, 1, N1),
+  sub(K, 1, K1),
+  binomial(N1, K1, Left),
+  binomial(N1, K, Right),
+  add(Left, Right, Value).
+
+signed_term(N, K, I, Term) :-
+  binomial(K, I, C),
+  pow(I, N, P),
+  mul(C, P, Unsigned),
+  sub(K, I, D),
+  mod(D, 2, 0),
+  eq(Term, Unsigned).
+signed_term(N, K, I, Term) :-
+  binomial(K, I, C),
+  pow(I, N, P),
+  mul(C, P, Unsigned),
+  sub(K, I, D),
+  mod(D, 2, 1),
+  neg(Unsigned, Term).
+
+stirling2(0, 0, 1).
+stirling2(N, 0, 0) :- gt(N, 0).
+stirling2(0, K, 0) :- gt(K, 0).
+stirling2(N, K, Count) :-
+  gt(N, 0),
+  gt(K, 0),
+  sumall(Term, (between(0, K, I), signed_term(N, K, I, Term)), Sum),
+  factorial(K, Factorial),
+  div(Sum, Factorial, Count).
+
+bell(0, 1).
+bell(N, Count) :-
+  gt(N, 0),
+  sub(N, 1, N1),
+  sumall(Term, (between(0, N1, K), binomial(N1, K, Choose), bell(K, Bell), mul(Choose, Bell, Term)), Count).
+
+stirling_bell_answer(stirling_10_4, Count) :- stirling2(10, 4, Count).
+stirling_bell_answer(stirling_12_5, Count) :- stirling2(12, 5, Count).
+stirling_bell_answer(bell_10, Count) :- bell(10, Count).
+stirling_bell_answer(bell_12, Count) :- bell(12, Count).

package/examples/sudoku-4x4.pl

@@ -0,0 +1,54 @@
+% Compact 4x4 Sudoku search with row permutations and column/box constraints.
+%
+% The givens are baked into row1/1 ... row4/1, so each candidate row is already
+% a permutation of 1..4.  sudoku_solution/1 then checks the remaining columns
+% and 2x2 boxes, which keeps the example clear and playground-friendly.
+materialize(sudoku_answer, 2).
+
+perm([], []).
+perm(Items, [X|Rest]) :-
+  select(X, Items, Remaining),
+  perm(Remaining, Rest).
+
+% distinct/1 is the reusable all-different constraint.
+distinct([]).
+distinct([X|Xs]) :-
+  not_member(X, Xs),
+  distinct(Xs).
+
+row1([1, B, C, 4]) :- perm([1, 2, 3, 4], [1, B, C, 4]).
+row2([A, 4, 1, D]) :- perm([1, 2, 3, 4], [A, 4, 1, D]).
+row3([B, 1, 4, C]) :- perm([1, 2, 3, 4], [B, 1, 4, C]).
+row4([4, C, B, 1]) :- perm([1, 2, 3, 4], [4, C, B, 1]).
+
+column([R1, R2, R3, R4], Index, [A, B, C, D]) :-
+  nth0(Index, R1, A),
+  nth0(Index, R2, B),
+  nth0(Index, R3, C),
+  nth0(Index, R4, D).
+
+% The four boxes are extracted as lists, then passed through distinct/1.
+boxes([R1, R2, R3, R4], [Box1, Box2, Box3, Box4]) :-
+  nth0(0, R1, A), nth0(1, R1, B), nth0(0, R2, C), nth0(1, R2, D),
+  eq(Box1, [A, B, C, D]),
+  nth0(2, R1, E), nth0(3, R1, F), nth0(2, R2, G), nth0(3, R2, H),
+  eq(Box2, [E, F, G, H]),
+  nth0(0, R3, I), nth0(1, R3, J), nth0(0, R4, K), nth0(1, R4, L),
+  eq(Box3, [I, J, K, L]),
+  nth0(2, R3, M), nth0(3, R3, N), nth0(2, R4, O), nth0(3, R4, P),
+  eq(Box4, [M, N, O, P]).
+
+sudoku_solution([R1, R2, R3, R4]) :-
+  row1(R1),
+  row2(R2),
+  row3(R3),
+  row4(R4),
+  column([R1, R2, R3, R4], 0, C0), distinct(C0),
+  column([R1, R2, R3, R4], 1, C1), distinct(C1),
+  column([R1, R2, R3, R4], 2, C2), distinct(C2),
+  column([R1, R2, R3, R4], 3, C3), distinct(C3),
+  boxes([R1, R2, R3, R4], [B1, B2, B3, B4]),
+  distinct(B1), distinct(B2), distinct(B3), distinct(B4).
+
+sudoku_answer(solution, Grid) :- once(sudoku_solution(Grid)).
+sudoku_answer(solution_count, Count) :- countall(sudoku_solution(_grid), Count).

package/examples/superdense-coding.pl

@@ -0,0 +1,84 @@
+% Superdense coding using discrete quantum computing, adapted from
+% Eyelet's input/superdense-coding.pl.
+%
+% The Eyelet program toggles dynamic sdcoding/2 facts so answers appearing an
+% even number of times cancel. seam expresses the same finite example
+% declaratively: for this protocol the surviving messages are exactly those
+% with a single support path after the interference choices are expanded.
+
+% |R) = |0, 0) + |1, 1)
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(decodesAs, 2).
+materialize(preservesMessage, 2).
+materialize(cancelsCrossTalk, 2).
+
+% Program structure: facts set up the scenario, and rules derive the materialized conclusions.
+r(false, false).
+r(true, true).
+
+% ID |0) = |0), ID |1) = |1)
+identity(false, false).
+identity(true, true).
+
+% G |0) = |1), G |1) = |0)
+g(false, true).
+g(true, false).
+
+% K |0) = |0), K |1) = |0) + |1)
+k(false, false).
+k(true, false).
+k(true, true).
+
+% KG and GK compositions.
+% Derivation rules: each rule below contributes one logical step toward the displayed results.
+kg(X, Y) :-
+  g(X, Z),
+  k(Z, Y).
+
+gk(X, Y) :-
+  k(X, Z),
+  g(Z, Y).
+
+% Alice encodes two classical bits as one of four transformations.
+alice(0, X, Y) :- identity(X, Y).
+alice(1, X, Y) :- g(X, Y).
+alice(2, X, Y) :- k(X, Y).
+alice(3, X, Y) :- kg(X, Y).
+
+% Bob decodes with the Bell-style measurement basis.
+bob(X, Y, 0) :- gk(X, Y).
+bob(X, Y, 1) :- k(X, Y).
+bob(X, Y, 2) :- g(X, Y).
+bob(X, Y, 3) :- identity(X, Y).
+
+% One concrete support path through the entangled pair and the two transforms.
+sdc_path(N, M, path(X, Y, B)) :-
+  r(X, Y),
+  alice(N, X, B),
+  bob(B, Y, M).
+
+% If another different support path gives the same answer, this answer cancels
+% in pairs in the finite superdense-coding table.
+duplicate_sdc_path(N, M, Proof) :-
+  sdc_path(N, M, Proof),
+  sdc_path(N, M, Other),
+  neq(Proof, Other).
+
+sdcoding(N, M) :-
+  sdc_path(N, M, Proof),
+  not(duplicate_sdc_path(N, M, Proof)).
+
+decodesAs(message(N), M) :-
+  sdcoding(N, M).
+
+preservesMessage(protocol, true) :-
+  sdcoding(0, 0),
+  sdcoding(1, 1),
+  sdcoding(2, 2),
+  sdcoding(3, 3).
+
+cancelsCrossTalk(protocol, true) :-
+  not(sdcoding(0, 1)),
+  not(sdcoding(1, 0)),
+  not(sdcoding(2, 3)),
+  not(sdcoding(3, 2)).

package/examples/symbolic-derivative.pl

@@ -0,0 +1,39 @@
+% Symbolic differentiation over explicit expression terms.
+%
+% The source derivative example uses Prolog operators such as `+`, `*`, `^`, and
+% cut.  Seam keeps expressions as ordinary terms: `add/2`, `mul/2`, `pow/2`,
+% `log/1`, and so on.  The result is intentionally unsimplified so the rule that
+% produced each part remains visible.
+
+materialize(derivative_result, 2).
+
+expr(square, mul(var(x), var(x))).
+expr(linear_plus_const, add(var(x), const(3))).
+expr(product, mul(add(var(x), const(1)), mul(add(pow(var(x), 2), const(2)), add(pow(var(x), 3), const(3))))).
+expr(nested_log, log(log(var(x)))).
+
+d(const(_c), _x, const(0)).
+d(var(X), X, const(1)).
+d(var(Y), X, const(0)) :-
+  neq(X, Y).
+d(add(U, V), X, add(Du, Dv)) :-
+  d(U, X, Du),
+  d(V, X, Dv).
+d(sub(U, V), X, sub(Du, Dv)) :-
+  d(U, X, Du),
+  d(V, X, Dv).
+d(mul(U, V), X, add(mul(Du, V), mul(U, Dv))) :-
+  d(U, X, Du),
+  d(V, X, Dv).
+d(divide(U, V), X, divide(sub(mul(Du, V), mul(U, Dv)), pow(V, 2))) :-
+  d(U, X, Du),
+  d(V, X, Dv).
+d(pow(U, N), X, mul(mul(const(N), pow(U, N1)), Du)) :-
+  sub(N, 1, N1),
+  d(U, X, Du).
+d(log(U), X, divide(Du, U)) :-
+  d(U, X, Du).
+
+derivative_result(Name, Derivative) :-
+  expr(Name, Expr),
+  d(Expr, x, Derivative).

package/examples/term-tools.pl

@@ -0,0 +1,32 @@
+% Term-tool builtins for inspecting, constructing, rendering, and validating
+% structured terms.
+%
+% Each report/2 answer demonstrates one meta-programming operation over ordinary
+% Seam terms: functor/3 and arg/3 inspect shape, compound_name_arguments/3 can
+% decompose or rebuild a compound, term_string/2 renders a term, and forall/2
+% validates all edge weights.
+%
+% This is a good reference example when writing rules that need to treat terms as
+% data rather than only as predicate calls.
+materialize(report, 2).
+
+edge(a, b, 3).
+edge(b, c, 4).
+
+report(shape, shape(Name, Arity)) :-
+  functor(edge(a, b, 3), Name, Arity).
+
+report(second_argument, Node) :-
+  arg(2, edge(a, b, 3), Node).
+
+report(parts, parts(Name, Args)) :-
+  compound_name_arguments(edge(a, b, 3), Name, Args).
+
+report(rebuilt, Term) :-
+  compound_name_arguments(Term, edge, [c, d, 5]).
+
+report(rendered, Text) :-
+  term_string(edge(a, [b, c]), Text).
+
+report(all_weights_positive, yes) :-
+  forall(edge(_from, _to, Weight), gt(Weight, 0)).

package/examples/totient-summatory.pl

@@ -0,0 +1,33 @@
+% Euler totients and coprimality by tabled Euclidean gcd.
+%
+% phi(N) is modeled directly as the count of integers K in 1..N with gcd(N,K)=1.
+% The summatory query reuses many gcd/totient subgoals, so memoization keeps the
+% example responsive while preserving the relational presentation.
+materialize(totient_answer, 2).
+
+table(gcd, 3).
+table(totient, 2).
+
+% Euclid's algorithm is expressed recursively over remainders.
+gcd(A, 0, A) :- ge(A, 0).
+gcd(A, B, G) :-
+  gt(B, 0),
+  mod(A, B, R),
+  gcd(B, R, G).
+
+coprime_upto(N, K) :-
+  between(1, N, K),
+  gcd(N, K, 1).
+
+% Count the finite coprime generator instead of constructing an explicit list.
+totient(N, Count) :-
+  gt(N, 0),
+  countall(coprime_upto(N, _k), Count).
+
+summatory_totient(Limit, Sum) :-
+  sumall(Phi, (between(1, Limit, N), totient(N, Phi)), Sum).
+
+totient_answer(phi_36, Phi) :- totient(36, Phi).
+totient_answer(phi_97, Phi) :- totient(97, Phi).
+totient_answer(coprime_count_84, Count) :- totient(84, Count).
+totient_answer(summatory_phi_30, Sum) :- summatory_totient(30, Sum).

package/examples/trust-flow-provenance-threshold.pl

@@ -0,0 +1,47 @@
+% Provenance-derived trust-flow thresholding in Seam.
+%
+% Each message combines publisher trust, signature strength, and transform quality
+% into one confidence score.  Receiver-specific thresholds then classify messages
+% as accepted or quarantined and derive status/risk facts.
+%
+% The multiplication chain is intentionally explicit so proof output shows how a
+% provenance trail becomes a single trust decision.
+
+materialize(confidence, 2).
+materialize(trust_flow_state, 2).
+materialize(status, 2).
+materialize(risk, 2).
+
+message(message_a, publisher_a, transform_a, signature_a, receiver_app).
+message(message_b, publisher_b, transform_b, signature_b, receiver_app).
+
+publisher_trust(publisher_a, 0.95).
+publisher_trust(publisher_b, 0.70).
+signature_strength(signature_a, 0.98).
+signature_strength(signature_b, 0.75).
+quality_score(transform_a, 0.96).
+quality_score(transform_b, 0.80).
+acceptance_threshold(receiver_app, 0.85).
+
+confidence(Message, Confidence) :-
+  message(Message, Publisher, Transform, Signature, _receiver),
+  publisher_trust(Publisher, Publishertrust),
+  signature_strength(Signature, Signaturetrust),
+  quality_score(Transform, Quality),
+  mul(Publishertrust, Signaturetrust, A),
+  mul(A, Quality, Confidence).
+
+trust_flow_state(Message, fpv_accepted) :-
+  message(Message, _publisher, _transform, _signature, Receiver),
+  confidence(Message, Confidence),
+  acceptance_threshold(Receiver, Threshold),
+  ge(Confidence, Threshold).
+
+trust_flow_state(Message, fpv_quarantine) :-
+  message(Message, _publisher, _transform, _signature, Receiver),
+  confidence(Message, Confidence),
+  acceptance_threshold(Receiver, Threshold),
+  lt(Confidence, Threshold).
+
+status(Message, fpv_high_trust_flow) :- trust_flow_state(Message, fpv_accepted).
+risk(Message, risk_low_trust_data_source) :- trust_flow_state(Message, fpv_quarantine).

package/examples/truth-maintenance-system.pl

@@ -0,0 +1,62 @@
+% A tiny assumption-based truth maintenance system.
+%
+% An environment is a set of assumptions.  Justifications derive beliefs from
+% assumptions and from other derived beliefs.  The TMS can therefore explain
+% which environments support a belief and which environments are inconsistent
+% because they support contradictory conclusions.
+
+materialize(tmsSupport, 2).
+materialize(tmsJustification, 3).
+materialize(tmsInconsistent, 1).
+materialize(tmsConclusion, 2).
+
+table(supported, 2).
+
+% Candidate environments.
+environment(clear_only, [sensor_clear]).
+environment(blocked_only, [sensor_blocked]).
+environment(conflicting_sensors, [sensor_clear, sensor_blocked]).
+environment(override_blocked, [sensor_blocked, operator_override]).
+
+assumes(Environment, Assumption) :-
+  environment(Environment, Assumptions),
+  member(Assumption, Assumptions).
+
+% Justifications.  Preconditions are either assumption(Name) or another derived
+% belief.  The last justification says an operator override can permit motion
+% even when the blocked-path belief is also present.
+justification(j_clear_path, [assumption(sensor_clear)], clear_path).
+justification(j_blocked_path, [assumption(sensor_blocked)], blocked_path).
+justification(j_permit_from_clear, [clear_path], permit_go).
+justification(j_forbid_from_blocked, [blocked_path], forbid_go).
+justification(j_override, [assumption(operator_override), blocked_path], permit_go).
+
+all_hold(_, []).
+all_hold(Environment, [assumption(Assumption) | Rest]) :-
+  assumes(Environment, Assumption),
+  all_hold(Environment, Rest).
+all_hold(Environment, [Belief | Rest]) :-
+  supported(Environment, Belief),
+  all_hold(Environment, Rest).
+
+supported(Environment, Belief) :-
+  justification(_, Preconditions, Belief),
+  all_hold(Environment, Preconditions).
+
+contradicts(permit_go, forbid_go).
+contradicts(forbid_go, permit_go).
+inconsistent(Environment) :-
+  supported(Environment, Left),
+  supported(Environment, Right),
+  contradicts(Left, Right).
+
+% Show the actual justifications that fired, not just the final supported beliefs.
+fires(Environment, Justification, Belief) :-
+  justification(Justification, Preconditions, Belief),
+  all_hold(Environment, Preconditions).
+
+tmsSupport(Environment, Belief) :- supported(Environment, Belief).
+tmsJustification(Environment, Justification, Belief) :- fires(Environment, Justification, Belief).
+tmsInconsistent(Environment) :- inconsistent(Environment).
+tmsConclusion(case, "truth maintenance separates support from consistency across assumption environments") :-
+  inconsistent(conflicting_sensors).

package/examples/turing.pl

@@ -0,0 +1,69 @@
+% Universal Turing machine example adapted from Eyelet's input/turing.pl.
+%
+% The machine below adds 1 to a binary number represented as a list of bits.
+% A tape is split into a reversed left side, current cell, and right side; move/7
+% updates that zipper representation.  The blank tape symbol is #.
+
+% Output declarations: materialize/2 selects the relations written to this example's golden output.
+materialize(input, 2).
+materialize(output, 2).
+materialize(addsOne, 2).
+
+% compute/2 initializes the tape and starts from the machine's start state.
+compute([], Outtape) :-
+  start(_machine, I),
+  find(I, [], #, [], Outtape).
+
+compute([Head|Tail], Outtape) :-
+  start(_machine, I),
+  find(I, [], Head, Tail, Outtape).
+
+% find/5 executes one transition, moves the head, and either halts or recurses.
+find(State, Left, Cell, Right, Outtape) :-
+  t([State, Cell, Write, Move], Next),
+  move(Move, Left, Write, Right, A, B, C),
+  continue(Next, A, B, C, Outtape).
+
+continue(halt, Left, Cell, Right, Outtape) :-
+  rever(Left, R),
+  append(R, [Cell|Right], Outtape).
+
+continue(State, Left, Cell, Right, Outtape) :-
+  find(State, Left, Cell, Right, Outtape).
+
+% Head movement defines the tape zipper update, including blank extension.
+move(l, [], Cell, Right, [], #, [Cell|Right]).
+move(l, [Head|Tail], Cell, Right, Tail, Head, [Cell|Right]).
+move(s, Left, Cell, Right, Left, Cell, Right).
+move(r, Left, Cell, [], [Cell|Left], #, []).
+move(r, Left, Cell, [Head|Tail], [Cell|Left], Head, Tail).
+
+rever([], []).
+rever([A|B], C) :-
+  rever(B, D),
+  append(D, [A], C).
+
+% A Turing machine to add 1 to a binary number.
+start(add1, 0).
+t([0, 0, 0, r], 0).
+t([0, 1, 1, r], 0).
+t([0, #, #, l], 1).
+t([1, 0, 1, s], halt).
+t([1, 1, 0, l], 1).
+t([1, #, 1, s], halt).
+
+case(case1, [1, 0, 1, 0, 0, 1]).
+case(case2, [1, 0, 1, 1, 1, 1]).
+case(case3, [1, 1, 1, 1, 1, 1]).
+case(case4, []).
+
+input(Case, Intape) :-
+  case(Case, Intape).
+
+output(Case, Outtape) :-
+  case(Case, Intape),
+  compute(Intape, Outtape).
+
+addsOne(Case, true) :-
+  case(Case, Intape),
+  compute(Intape, _outtape).

package/examples/type-inference.pl

@@ -0,0 +1,58 @@
+% Hindley-Milner-style type inference for a tiny lambda language.
+%
+% The example is intentionally small and deterministic.  Lambda binders carry
+% explicit type variables or annotations, and ordinary logic unification solves
+% the constraints created by application, arithmetic, conditionals, and pairs.
+% The symbolic names t0, t1, and t2 stand for schematic type variables in the
+% displayed answers; concrete examples such as apply_id annotate the argument as
+% int so the application can be checked.
+materialize(type_answer, 2).
+materialize(type_reason, 2).
+
+table(type_expr, 3).
+
+% Tiny expression language: int_lit/1, bool_lit/1, var/1, lam/3, app/2,
+% add/2, if/3, pair/2, fst/1, and snd/1.
+program(id, lam(x, t0, var(x))).
+program(const, lam(x, t0, lam(y, t1, var(x)))).
+program(apply_id, app(lam(x, int, var(x)), int_lit(42))).
+program(compose,
+  lam(f, fun(t1, t2),
+    lam(g, fun(t0, t1),
+      lam(x, t0,
+        app(var(f), app(var(g), var(x))))))).
+program(branch,
+  if(bool_lit(true), add(int_lit(20), int_lit(22)), int_lit(0))).
+program(first_of_pair, fst(pair(bool_lit(true), int_lit(7)))).
+
+lookup(Name, [[Name, Type] | _], Type).
+lookup(Name, [[_, _] | Rest], Type) :- lookup(Name, Rest, Type).
+
+type_expr(_, int_lit(_), int).
+type_expr(_, bool_lit(_), bool).
+type_expr(Env, var(Name), Type) :- lookup(Name, Env, Type).
+type_expr(Env, lam(Name, Arg_type, Body), fun(Arg_type, Body_type)) :-
+  type_expr([[Name, Arg_type] | Env], Body, Body_type).
+type_expr(Env, app(Fn, Arg), Result_type) :-
+  type_expr(Env, Fn, fun(Arg_type, Result_type)),
+  type_expr(Env, Arg, Arg_type).
+type_expr(Env, add(Left, Right), int) :-
+  type_expr(Env, Left, int),
+  type_expr(Env, Right, int).
+type_expr(Env, if(Cond, Then, Else), Type) :-
+  type_expr(Env, Cond, bool),
+  type_expr(Env, Then, Type),
+  type_expr(Env, Else, Type).
+type_expr(Env, pair(Left, Right), pair(Left_type, Right_type)) :-
+  type_expr(Env, Left, Left_type),
+  type_expr(Env, Right, Right_type).
+type_expr(Env, fst(Pair), Left_type) :-
+  type_expr(Env, Pair, pair(Left_type, _)).
+type_expr(Env, snd(Pair), Right_type) :-
+  type_expr(Env, Pair, pair(_, Right_type)).
+
+type_answer(Name, Type) :- program(Name, Expr), type_expr([], Expr, Type).
+type_reason(compose, "application unifies f with t1 -> t2 and g with t0 -> t1") :-
+  type_answer(compose, _).
+type_reason(apply_id, "the identity function's parameter type is unified with int") :-
+  type_answer(apply_id, int).

package/examples/vector-similarity.pl

@@ -0,0 +1,60 @@
+% Vector dot product, Euclidean norm, and cosine similarity.
+%
+% Recursive list folds compute the dot product and squared-length sums.  The
+% public cosineSimilarity/2 report then combines those folds as
+% dot(A,B)/(norm(A)*norm(B)) for a named vector pair.
+%
+% The example keeps vectors as ordinary Seam lists, so it doubles as a compact
+% demonstration of numeric recursion over list structure.
+
+materialize(dotProduct, 2).
+materialize(normA, 2).
+materialize(normB, 2).
+materialize(cosineSimilarity, 2).
+
+% Two named vectors form the single cosine-similarity case.
+vector(pair1, a, [1.0, 2.0, 3.0]).
+vector(pair1, b, [4.0, -5.0, 6.0]).
+
+% Recursive list folds compute dot products and sums of squares.
+dot([], [], 0.0).
+dot([A|As], [B|Bs], Dot) :-
+  mul(A, B, Product),
+  dot(As, Bs, Rest),
+  add(Product, Rest, Dot).
+
+sum_squares([], 0.0).
+sum_squares([X|Xs], Total) :-
+  pow(X, 2.0, Squared),
+  sum_squares(Xs, Rest),
+  add(Squared, Rest, Total).
+
+norm(Vector, Norm) :-
+  sum_squares(Vector, Sumsquares),
+  pow(Sumsquares, 0.5, Norm).
+
+% cosine = dot(A,B) / (norm(A) * norm(B)).
+cosine_similarity(Case, Similarity) :-
+  vector(Case, a, A),
+  vector(Case, b, B),
+  dot(A, B, Dot),
+  norm(A, Norma),
+  norm(B, Normb),
+  mul(Norma, Normb, Denominator),
+  div(Dot, Denominator, Similarity).
+
+dotProduct(Case, Dot) :-
+  vector(Case, a, A),
+  vector(Case, b, B),
+  dot(A, B, Dot).
+
+normA(Case, Norma) :-
+  vector(Case, a, A),
+  norm(A, Norma).
+
+normB(Case, Normb) :-
+  vector(Case, b, B),
+  norm(B, Normb).
+
+cosineSimilarity(Case, Similarity) :-
+  cosine_similarity(Case, Similarity).