Two utility functions:
prefix_sums xs builds Array of len n+1 such that
arr.(i) = sum of xs[0..i-1]
range_sum p lo hi = p.(hi+1) - p.(lo)
For [3;1;4;1;5;9;2;6;5;3]:
range_sum 0 4 = 14 (3+1+4+1+5)
range_sum 5 9 = 25 (9+2+6+5+3)
range_sum 2 7 = 27 (4+1+5+9+2+6)
sum = 66
Tests List.iter mutating Array indexed by a ref counter, plus the
classic prefix-sum technique for O(1) range queries.
67 baseline programs total.
Replace the single-pass body run with table-2-slg-iter / table-3-slg-iter:
each iteration stores the current vals in cache and re-runs the body;
loop until vals length stops growing. The cache thus grows
monotonically until no new answers appear.
For simple cycles (single tabled relation) this is sound and
terminating — len comparison is O(1) and the cache only grows.
Limitation: mutually-recursive tabled relations have INDEPENDENT
iteration loops. Each runs to its own fixed point in isolation; the
two don't coordinate. True SLG uses a worklist that cross-fires
re-iteration when any subgoal's cache grows. Left as a future
refinement.
All 5 SLG tests still pass (Fibonacci unchanged, 3 cyclic-patho
cases unchanged).
Solves the canonical cyclic-graph divergence problem from the deferred
plan. Naive memoization (table-1/2/3 in tabling.sx) drains the body's
answer stream eagerly; cyclic recursive calls with the same ground key
diverge before populating the cache.
table-2-slg / table-3-slg add an in-progress sentinel: before
evaluating the body, mark the cache entry :in-progress. Any recursive
call to the same key sees the sentinel and returns mzero (no answers
yet). Outer recursion thus terminates on cycles. After the body
finishes, the sentinel is replaced with the actual answer-value list.
Demo: tab-patho with a 3-edge graph (a -> b, b -> a, b -> c).
(run* q (tab-patho :a :c q)) -> ((:a :b :c)) ; finite
(run* q (tab-patho :a :a q)) -> ((:a :b :a)) ; one cycle visit
(run* q (tab-patho :a :b q)) -> ((:a :b)) ; direct edge
Without SLG, all three diverge.
Limitation: single-pass — answers found by cycle-dependent recursive
calls are not iteratively re-discovered. Full SLG with fixed-point
iteration (re-running until no new answers) is left for follow-up.
5 new tests including SLG-fib for sanity (matches naive table-2),
3 cyclic patho cases.
(=/= u v) posts a closure to the same _fd constraint store the
CLP(FD) goals use; the closure is fd-fire-store-driven, so it
re-checks after every binding.
Semantics:
- mk-unify u v s; nil result -> distinct, drop the constraint.
- unify succeeded with no new bindings (key-count unchanged) -> equal,
fail.
- otherwise -> partially unifiable, keep the constraint.
==-cs is the constraint-aware drop-in for == that fires fd-fire-store
after the binding; plain == doesn't reactivate the store, so a binding
that should violate a pending =/= would go undetected. Use ==-cs
whenever a program mixes =/= (or fd-* goals re-checked after non-FD
bindings) with regular unification.
12 new tests covering ground/structural/late-binding cases; 60/60
clpfd-and-diseq tests pass.
Two CLP(FD) demo puzzles plus an underlying improvement.
clpfd.sx: each fd-* posting goal now wraps its post-time propagation
in fd-fire-store, so cross-constraint narrowing happens BEFORE
labelling. Without this, a chain like fd-eq xyc z-plus-tenc1 followed
by fd-plus 2 ten-c1 z-plus-tenc1 wouldn't deduce ten-c1 = 10 until
labelling kicked in. Now the deduction happens at goal-construction
time. Guard against (c s2) returning nil before fd-fire-store runs.
tests/send-more-money.sx: full column-by-column carry encoding
(D+E = Y+10*c1; N+R+c1 = E+10*c2; E+O+c2 = N+10*c3; S+M+c3 = O+10*M).
Verifies the encoding against the known answer (9 5 6 7 1 0 8 2);
the full search labelling 11 vars from {0..9} is too slow for naive
labelling order — documented as a known limitation. Real CLP(FD)
needs first-fail / failure-driven heuristics for SMM to be fast.
tests/sudoku-4x4.sx: 16 cells / 12 distinctness constraints. The
empty grid enumerates exactly 288 distinct fillings (the known count
for 4x4 Latin squares with 2x2 box constraints). An impossible-clue
test (two 1s in row 0) fails immediately.
50/50 sudoku + smm tests, full clpfd suite green at 132/132.
Board as 9-element flat int array, 0=empty, 1=X, 2=O. Three
predicate functions:
check_row b r check_col b c check_diag b
each return the winning player's mark or 0. Main 'winner' loops
i = 0..2 calling row(i)/col(i) then check_diag, threading via a
result ref.
Test board:
X X X
. O .
. . O
X wins on row 0 -> winner returns 1.
Tests Array.of_list with row-major 'b.(r * 3 + c)' indexing,
multi-fn collaboration, and structural equality on int values.
66 baseline programs total.
Pure recursion — at each element, take it or don't:
let rec count_subsets xs target =
match xs with
| [] -> if target = 0 then 1 else 0
| x :: rest ->
count_subsets rest target
+ count_subsets rest (target - x)
For [1;2;3;4;5;6;7;8] target 10, the recursion tree has 2^8 = 256
leaves. Returns 8 — number of subsets summing to 10:
1+2+3+4, 1+2+7, 1+3+6, 1+4+5, 2+3+5, 2+8, 3+7, 4+6 = 8
Tests doubly-recursive list traversal pattern with single-arg list
+ accumulator-via-target.
65 baseline programs total.
Iterative Collatz / hailstone sequence:
let collatz_length n =
let m = ref n in
let count = ref 0 in
while !m > 1 do
if !m mod 2 = 0 then m := !m / 2
else m := 3 * !m + 1;
count := !count + 1
done;
!count
27 is the famous 'long-running' Collatz starter. Reaches a peak of
9232 mid-sequence and takes 111 steps to bottom out at 1.
64 baseline programs total.
fd-plus-prop now propagates in the four partial- and all-domain cases
(vvn, nvv, vnv, vvv) by interval reasoning:
x in [z.min - y.max .. z.max - y.min]
y in [z.min - x.max .. z.max - x.min]
z in [x.min + y.min .. x.max + y.max]
Helpers added:
fd-narrow-or-skip — common "no-domain? skip; else filter & set" path.
fd-int-floor-div / fd-int-ceil-div — integer-division wrappers because
SX `/` returns rationals; floor/ceil computed via (a - (mod a b)).
fd-times-prop gets the same treatment for positive domains. Mixed-sign
domains pass through (sound, but no narrowing).
10 new tests in clpfd-bounds.sx demonstrate domains shrinking BEFORE
labelling: x+y=10 with x in {1..10}, y in {1..3} narrows x to {7..9};
3*y=z narrows z to {3..12}; impossible bounds (x+y=100, x,y in {1..10})
return :no-subst directly. 132/132 across the clpfd test files.
Suggested next: Piece D (send-more-money + Sudoku 4x4) to validate
this against larger puzzles.
Walks list with List.iteri, checking if target - x is already in
the hashtable; if yes, the earlier index plus current is the
answer; otherwise record the current pair.
twosum [2;7;11;15] 9 = (0, 1) 2+7
twosum [3;2;4] 6 = (1, 2) 2+4
twosum [3;3] 6 = (0, 1) 3+3
Sum of i+j over each pair: 1 + 3 + 1 = 5.
Tests Hashtbl.find_opt + add (the iter-99 cleanup), List.iteri, and
tuple destructuring on let-binding (iter 98 'let (i, j) = twosum
... in').
63 baseline programs total.
Bug-hunt round probed magic-sets against many edge cases. No new
bugs surfaced. Added regression tests for two patterns that
exercise the worklist post-fix:
- 3-stratum program (a → c via not-b → d via not-banned).
Distinct rule heads at three strata; magic must rewrite each.
- Aggregate-derived chain (count(src) → cnt → active threshold).
Magic correctly handles multi-step aggregate dependencies.
Magic-sets is robust against: 3-stratum negation, aggregate
chains, mutual recursion, all-bound goals, multi-arity rules,
diagonal queries, EDB-only goals, and rules whose body has
identical positive lits.
Captures the work left on the shelf after the loops/minikanren squash
merge:
Piece A — Phase 7 SLG (cyclic patho, mutual recursion). The hardest
piece; the brief's "research-grade complexity" caveat
still stands. Plan documents the in-progress sentinel +
answer-accumulator + fixed-point-driver design.
Piece B — Phase 6 polish: bounds-consistency for fd-plus / fd-times
in the (var var var) case. Math is straightforward
interval reasoning; low risk, self-contained.
Piece C — =/= disequality with a constraint store. Generalises
nafc / fd-neq to logic terms via a pending-disequality
list re-checked after each ==.
Piece D — Bigger CLP(FD) demos: send-more-money and Sudoku 4x4.
Both validate Piece B once it lands.
Suggested ordering: B (low risk, unlocks D) → D (concrete validation)
→ C (independent track) → A (highest risk, do last).
Operating ground rules carried over from the original loop brief:
loops/minikanren branch, sx-tree MCP only, one feature per commit,
test count must monotonically grow.
Bisection method searching for f(x) = 0 in [lo, hi] over 50
iterations:
let bisect f lo hi =
let lo = ref lo and hi = ref hi in
for _ = 1 to 50 do
let mid = (!lo +. !hi) /. 2.0 in
if f mid = 0.0 || f !lo *. f mid < 0.0 then hi := mid
else lo := mid
done;
!lo
Solving x^2 - 2 = 0 in [1, 2] via 'bisect (fun x -> x *. x -. 2.0)
1.0 2.0' converges to ~1.41421356... -> int_of_float (r *. 100) =
141.
Tests:
- higher-order function passing
- multi-let 'let lo = ref ... and hi = ref ...'
- float arithmetic
- int_of_float truncate-toward-zero (iter 117)
62 baseline programs total.
36-character digit alphabet '0..9A..Z' supports any base 2..36. Loop
divides the magnitude by base and prepends the digit:
while !m > 0 do
acc := String.make 1 digits.[!m mod base] ^ !acc;
m := !m / base
done
Special-cases n = 0 -> '0' and prepends '-' for negatives.
Test cases (length, since the strings differ in alphabet):
255 hex 'FF' 2
1024 binary '10000000000' 11
100 dec '100' 3
0 any base '0' 1
sum 17
Combines digits.[i] (string indexing) + String.make 1 ch + String
concatenation in a loop.
61 baseline programs total.
Three refs threading through a while loop:
m remaining quotient
d current divisor
result accumulator (built in reverse, List.rev at end)
while !m > 1 do
if !m mod !d = 0 then begin
result := !d :: !result;
m := !m / !d
end else
d := !d + 1
done
360 = 2^3 * 3^2 * 5 factors to [2;2;2;3;3;5], sum 17.
60 baseline programs total — milestone.
Models a bank account using a mutable record + a user exception:
type account = { mutable balance : int }
exception Insufficient
let withdraw acct amt =
if amt > acct.balance then raise Insufficient
else acct.balance <- acct.balance - amt
Sequence:
start 100
deposit 50 150
withdraw 30 120
withdraw 200 raises Insufficient
handler returns acct.balance (= 120, transaction rolled back)
Combines mutable record fields, user exception declaration,
try-with-bare-pattern, and verifies that a raise in the middle of a
sequence doesn't leave a partial mutation.
59 baseline programs total.
to_counts builds a 256-slot int array of character frequencies:
let to_counts s =
let counts = Array.make 256 0 in
for i = 0 to String.length s - 1 do
let c = Char.code s.[i] in
counts.(c) <- counts.(c) + 1
done;
counts
same_counts compares two arrays element-by-element via for loop +
bool ref. is_anagram composes them.
Four pairs:
listen ~ silent true
hello !~ world false
anagram ~ nagaram true
abc !~ abcd false (length differs)
sum 2
Exercises Array.make + arr.(i) + arr.(i) <- v + nested for loops +
Char.code + s.[i].
57 baseline programs total.
Defines a user exception with int payload:
exception Negative of int
let safe_sqrt n =
if n < 0 then raise (Negative n)
else <integer sqrt via while loop>
let try_sqrt n =
try safe_sqrt n with
| Negative x -> -x
try_sqrt 16 -> 4
try_sqrt 25 -> 5
try_sqrt -7 -> 7 (handler returns -(-7) = 7)
try_sqrt 100 -> 10
sum -> 26
Tests exception declaration with int payload, raise with carry, and
try-with arm pattern-matching the constructor with payload binding.
56 baseline programs total.
Defines a parametric tree:
type 'a tree = Leaf of 'a | Node of 'a tree list
let rec flatten t =
match t with
| Leaf x -> [x]
| Node ts -> List.concat (List.map flatten ts)
Test tree has 3 levels of nesting:
Node [Leaf 1; Node [Leaf 2; Leaf 3];
Node [Node [Leaf 4]; Leaf 5; Leaf 6];
Leaf 7]
flattens to [1;2;3;4;5;6;7] -> sum = 28.
Tests parametric ADT, mutual recursion via map+self, List.concat.
55 baseline programs total.
Two-line baseline:
let rec gcd a b = if b = 0 then a else gcd b (a mod b)
let lcm a b = a * b / gcd a b
gcd 36 48 = 12
lcm 4 6 = 12
lcm 12 18 = 36
sum = 60
Tests mod arithmetic and the integer-division fix from iteration 94
(without truncate-toward-zero, 'lcm 4 6 = 4 * 6 / 2 = 12.0' rather
than the expected 12).
54 baseline programs total.
zip walks both lists in lockstep, truncating at the shorter. unzip
uses tuple-pattern destructuring on the recursive result.
let pairs = zip [1;2;3;4] [10;20;30;40] in
let (xs, ys) = unzip pairs in
List.fold_left (+) 0 xs * List.fold_left (+) 0 ys
= 10 * 100
= 1000
Exercises:
- tuple-cons patterns in match scrutinee: 'match (xs, ys) with'
- tuple constructor in return value: '(a :: la, b :: lb)'
- the iter-98 let-tuple destructuring: 'let (la, lb) = unzip rest'
53 baseline programs total.
Recursive 4-arm match on (a, b) tuples threading a carry:
match (a, b) with
| ([], []) -> if carry = 0 then [] else [carry]
| (x :: xs, []) -> (s mod 10) :: aux xs [] (s / 10) where s = x + carry
| ([], y :: ys) -> ...
| (x :: xs, y :: ys) -> ... where s = x + y + carry
Little-endian digit lists. Three tests:
[9;9;9] + [1] = [0;0;0;1] (=1000, digit sum 1)
[5;6;7] + [8;9;1] = [3;6;9] (=963, digit sum 18)
[9;9;9;9;9;9;9;9] + [1] length 9 (carry propagates 8x)
Sum = 1 + 18 + 9 = 28.
Exercises tuple-pattern match on nested list-cons with the integer
arithmetic and carry-threading idiom typical of multi-precision
implementations.
52 baseline programs total.
Recursive ADT with three constructors (Num/Add/Mul). simp does
bottom-up rewrite using algebraic identities:
x + 0 -> x
0 + x -> x
x * 0 -> 0
0 * x -> 0
x * 1 -> x
1 * x -> x
constant folding for Num + Num and Num * Num
Uses tuple pattern in nested match: 'match (simp a, simp b) with'.
Add (Mul (Num 3, Num 5), Add (Num 0, Mul (Num 1, Num 7)))
-> simp -> Add (Num 15, Num 7)
-> eval -> 22
51 baseline programs total.
Triple-nested for loop with row-major indexing:
for i = 0 to n - 1 do
for j = 0 to n - 1 do
for k = 0 to n - 1 do
c.(i * n + j) <- c.(i * n + j) + a.(i * n + k) * b.(k * n + j)
done
done
done
For 3x3 matrices A=[[1..9]] and B=[[9..1]], the resulting C has sum
621. Tests deeply nested for loops on Array, Array.make + arr.(i) +
arr.(i) <- v + Array.fold_left.
50 baseline programs total — milestone.
Iterative binary search on a sorted int array:
let bsearch arr target =
let n = Array.length arr in
let lo = ref 0 and hi = ref (n - 1) in
let found = ref (-1) in
while !lo <= !hi && !found = -1 do
let mid = (!lo + !hi) / 2 in
if arr.(mid) = target then found := mid
else if arr.(mid) < target then lo := mid + 1
else hi := mid - 1
done;
!found
For [1;3;5;7;9;11;13;15;17;19;21]:
bsearch a 13 = 6
bsearch a 5 = 2
bsearch a 100 = -1
sum = 7
Exercises Array.of_list + arr.(i) + multi-let 'let lo = ... and
hi = ...' + while + multi-arm if/else if/else.
49 baseline programs total.
Two-pointer palindrome check:
let is_palindrome s =
let n = String.length s in
let rec check i j =
if i >= j then true
else if s.[i] <> s.[j] then false
else check (i + 1) (j - 1)
in
check 0 (n - 1)
Tests on six strings:
racecar = true
hello = false
abba = true
'' = true (vacuously, i >= j on entry)
'a' = true
'ab' = false
Sum = 4.
Uses s.[i] <> s.[j] (string-get + structural inequality), recursive
2-arg pointer advancement, and a multi-clause if/else if/else for
the three cases.
48 baseline programs total.
Bottom-up dynamic programming. dp[i] = minimum coins to make
amount i.
let dp = Array.make (target + 1) (target + 1) in (* sentinel *)
dp.(0) <- 0;
for i = 1 to target do
List.iter (fun c ->
if c <= i && dp.(i - c) + 1 < dp.(i) then
dp.(i) <- dp.(i - c) + 1
) coins
done
Sentinel 'target + 1' means impossible — any real solution uses at
most 'target' coins.
coin_change [1; 5; 10; 25] 67 = 6 (= 25+25+10+5+1+1)
Exercises Array.make + arr.(i) + arr.(i) <- v + nested
for/List.iter + guard 'c <= i'.
47 baseline programs total.
Kadane's algorithm in O(n):
let max_subarray xs =
let max_so_far = ref min_int in
let cur = ref 0 in
List.iter (fun x ->
cur := max x (!cur + x);
max_so_far := max !max_so_far !cur
) xs;
!max_so_far
For [-2;1;-3;4;-1;2;1;-5;4] the optimal subarray is [4;-1;2;1] = 6.
Exercises min_int (iter 94), max as global, ref / ! / :=, and
List.iter with two side-effecting steps in one closure body.
46 baseline programs total.
next_row prepends 1, walks adjacent pairs (x, y) emitting x+y,
appends a final 1:
let rec next_row prev =
let rec aux a =
match a with
| [_] -> [1]
| x :: y :: rest -> (x + y) :: aux (y :: rest)
| [] -> []
in
1 :: aux prev
row n iterates next_row n times starting from [1] using a ref +
'for _ = 1 to n do r := next_row !r done'.
row 10 = [1;10;45;120;210;252;210;120;45;10;1]
List.nth (row 10) 5 = 252 = C(10, 5)
Exercises three-arm match including [_] singleton wildcard, x :: y
:: rest binding, and the for-loop with wildcard counter. 45 baseline
programs total.
Run-length encoding via tail-recursive 4-arg accumulator:
let rle xs =
let rec aux xs cur n acc =
match xs with
| [] -> List.rev ((cur, n) :: acc)
| h :: t ->
if h = cur then aux t cur (n + 1) acc
else aux t h 1 ((cur, n) :: acc)
in
match xs with
| [] -> []
| h :: t -> aux t h 1 []
rle [1;1;1;2;2;3;3;3;3;1;1] = [(1,3);(2,2);(3,4);(1,2)]
sum of counts = 11 (matches input length)
The sum-of-counts test verifies that the encoding preserves total
length — drops or duplicates would diverge.
44 baseline programs total.
Defines a recursive str_contains that walks the haystack with
String.sub to find a needle substring. Real OCaml's String.contains
only accepts a single char, so this baseline implements its own
substring search to stay portable.
let rec str_contains s sub i =
if i + sl > nl then false
else if String.sub s i sl = sub then true
else str_contains s sub (i + 1)
count_matching splits text on newlines, folds with the predicate.
'the quick brown fox\nfox runs fast\nthe dog\nfoxes are clever'
needle = 'fox'
matches = 3 (lines 1, 2, 4 — 'foxes' contains 'fox')
43 baseline programs total.
The binop precedence table already had land/lor/lxor/lsl/lsr/asr
(iter 0 setup) but eval-op fell through to 'unknown operator' for
all of them. SX doesn't expose host bitwise primitives, so each is
implemented in eval.sx via arithmetic on the host:
land/lor/lxor: mask & shift loop, accumulating 1<<k digits
lsl k: repeated * 2 k times
lsr k: repeated floor (/ 2) k times
asr: aliased to lsr (no sign extension at our bit width)
bits.ml baseline: popcount via 'while m > 0 do if m land 1 = 1 then
... ; m := m lsr 1 done'. Sum of popcount(1023, 5, 1024, 0xff) = 10
+ 2 + 1 + 8 = 21.
5 land 3 = 1
5 lor 3 = 7
5 lxor 3 = 6
1 lsl 8 = 256
256 lsr 4 = 16
41 baseline programs total.
Classic Ackermann function:
let rec ack m n =
if m = 0 then n + 1
else if n = 0 then ack (m - 1) 1
else ack (m - 1) (ack m (n - 1))
ack(3, 4) = 125, expanding to ~6700 evaluator frames — a useful
stress test of the call stack and control transfer. Real OCaml
evaluates this in milliseconds; ours takes ~2 minutes on a
contended host but completes correctly.
40 baseline programs total.
Stack-based RPN evaluator:
let eval_rpn tokens =
let stack = Stack.create () in
List.iter (fun tok ->
if tok is operator then
let b = Stack.pop stack in
let a = Stack.pop stack in
Stack.push (apply tok a b) stack
else
Stack.push (int_of_string tok) stack
) tokens;
Stack.pop stack
For tokens [3 4 + 2 * 5 -]:
3 4 + -> 7
7 2 * -> 14
14 5 - -> 9
Exercises Stack.create / push / pop, mixed branch on string
equality, multi-arm if/else if for operator dispatch, int_of_string
for token parsing.
39 baseline programs total.
Newton's method for square root:
let sqrt_newton x =
let g = ref 1.0 in
for _ = 1 to 20 do
g := (!g +. x /. !g) /. 2.0
done;
!g
20 iterations is more than enough to converge for x=2 — result is
~1.414213562. Multiplied by 1000 and int_of_float'd: 1414.
First baseline exercising:
- for _ = 1 to N do ... done (wildcard loop variable)
- pure float arithmetic with +. /.
- the int_of_float truncate-toward-zero fix from iter 117
38 baseline programs total.
Classic doubly-recursive solution returning the move count:
hanoi n from to via =
if n = 0 then 0
else hanoi (n-1) from via to + 1 + hanoi (n-1) via to from
For n = 10, returns 2^10 - 1 = 1023.
Exercises 4-arg recursion, conditional base case, and tail-position
addition. Uses 'to_' instead of 'to' for the destination param to
avoid collision with the 'to' keyword in for-loops — the OCaml
conventional workaround.
37 baseline programs total.
