Two running sums modulo 65521:
a = (1 + sum of bytes) mod 65521
b = sum of running 'a' values mod 65521
checksum = b * 65536 + a
let adler32 s =
let a = ref 1 in
let b = ref 0 in
let m = 65521 in
for i = 0 to String.length s - 1 do
a := (!a + Char.code s.[i]) mod m;
b := (!b + !a) mod m
done;
!b * 65536 + !a
For 'Wikipedia': 0x11E60398 = 300286872 (the canonical test value).
Tests for-loop accumulating two refs together, modular arithmetic,
and Char.code on s.[i].
96 baseline programs total.
Single-formula generation:
gray[i] = i lxor (i lsr 1)
For n = 4, generates 16 values, each differing from its neighbour
by one bit. Output is a permutation of 0..15, so its sum equals the
natural-sequence sum 120; +16 entries -> 136.
Tests lsl / lxor / lsr together (the iter-127 bitwise ops) plus
Array.make / Array.fold_left.
95 baseline programs total.
Walks list keeping a previous-value reference; increments cur on
match, resets to 1 otherwise. Uses 'Some y when y = x' guard pattern
in match for the prev-value comparison:
let max_run xs =
let max_so_far = ref 0 in
let cur = ref 0 in
let last = ref None in
List.iter (fun x ->
(match !last with
| Some y when y = x -> cur := !cur + 1
| _ -> cur := 1);
last := Some x;
if !cur > !max_so_far then max_so_far := !cur
) xs;
!max_so_far
Three test cases:
[1;1;2;2;2;2;3;3;1;1;1] max run = 4 (the 2's)
[1;2;3;4;5] max run = 1
[] max run = 0
sum = 5
Tests 'when' guard pattern in match arm + Option ref + ref-mutation
sequence inside List.iter closure body.
94 baseline programs total.
Two-pointer walk:
let is_subseq s t =
let i = ref 0 in
let j = ref 0 in
while !i < n && !j < m do
if s.[!i] = t.[!j] then i := !i + 1;
j := !j + 1
done;
!i = n
advance i only on match; always advance j. Pattern matches if i
reaches n.
Five test cases:
'abc' in 'ahbgdc' yes
'axc' in 'ahbgdc' no (no x in t)
'' in 'anything' yes (empty trivially)
'abc' in 'abc' yes
'abcd' in 'abc' no (s longer)
sum = 3
93 baseline programs total.
Sort intervals by start, then sweep maintaining a current (cs, ce)
window — extend ce if next start <= ce, else push current and start
fresh:
let merge_intervals xs =
let sorted = List.sort (fun (a, _) (b, _) -> a - b) xs in
let rec aux acc cur xs =
match xs with
| [] -> List.rev (cur :: acc)
| (s, e) :: rest ->
let (cs, ce) = cur in
if s <= ce then aux acc (cs, max e ce) rest
else aux (cur :: acc) (s, e) rest
in
match sorted with
| [] -> []
| h :: rest -> aux [] h rest
[(1,3);(2,6);(8,10);(15,18);(5,9)]
-> [(1,10); (15,18)]
total length = 9 + 3 = 12
Tests List.sort with custom comparator using tuple patterns, plus
tuple destructuring in lambda + let-tuple from accumulator + match
arms.
92 baseline programs total.
Counts position-wise differences between two strings of equal
length; returns -1 sentinel for length mismatch:
let hamming s t =
if String.length s <> String.length t then -1
else
let d = ref 0 in
for i = 0 to String.length s - 1 do
if s.[i] <> t.[i] then d := !d + 1
done;
!d
Three test cases:
'karolin' vs 'kathrin' 3 (positions 2,3,4)
'1011101' vs '1001001' 2 (positions 2,4)
'abc' vs 'abcd' -1 (length mismatch)
sum 4
91 baseline programs total.
For each character, XOR with the corresponding key char (key cycled
via 'i mod kn'):
let xor_cipher key text =
let buf = Buffer.create n in
for i = 0 to n - 1 do
let c = Char.code text.[i] in
let k = Char.code key.[i mod kn] in
Buffer.add_string buf (String.make 1 (Char.chr (c lxor k)))
done;
Buffer.contents buf
XOR is its own inverse, so encrypt + decrypt with the same key yields
the original. Test combines:
- String.length decoded = 6
- decoded = 'Hello!' -> 1
- 6 * 100 + 1 = 601
Tests Char.code + Char.chr round-trip, the iter-127 lxor operator,
Buffer.add_string + String.make 1, and key-cycling via mod.
90 baseline programs total.
Composite Simpson's 1/3 rule with 100 panels:
let simpson f a b n =
let h = (b -. a) /. float_of_int n in
let sum = ref (f a +. f b) in
for i = 1 to n - 1 do
let x = a +. float_of_int i *. h in
let coef = if i mod 2 = 0 then 2.0 else 4.0 in
sum := !sum +. coef *. f x
done;
h *. !sum /. 3.0
The 1-4-2-4-...-4-1 coefficient pattern is implemented via even/odd
index dispatch. Endpoints get coefficient 1.
For x^2 over [0, 1], exact value is 1/3 ~= 0.33333. Scaled by 30000
gives 9999.99..., int_of_float -> 10000.
Tests higher-order function (passing the integrand 'fun x -> x *. x'),
float arithmetic in for-loop, and float_of_int for index->x conversion.
89 baseline programs total.
Newton's method on integers, converging when y >= x:
let isqrt n =
if n < 2 then n
else
let x = ref n in
let y = ref ((!x + 1) / 2) in
while !y < !x do
x := !y;
y := (!x + n / !x) / 2
done;
!x
Test cases:
isqrt 144 = 12 (perfect square)
isqrt 200 = 14 (floor of sqrt(200) ~= 14.14)
isqrt 1000000 = 1000
isqrt 2 = 1
sum = 1027
Companion to newton_sqrt.ml (iter 124, float Newton). Tests integer
division semantics from iter 94 and a while-until-convergence loop.
88 baseline programs total.
Uses the identities:
F(2k) = F(k) * (2 * F(k+1) - F(k))
F(2k+1) = F(k)^2 + F(k+1)^2
to compute Fibonacci in O(log n) recursive depth instead of O(n).
let rec fib_pair n =
if n = 0 then (0, 1)
else
let (a, b) = fib_pair (n / 2) in
let c = a * (2 * b - a) in
let d = a * a + b * b in
if n mod 2 = 0 then (c, d)
else (d, c + d)
Each call returns the pair (F(n), F(n+1)). fib(40) = 102334155 fits
in JS safe-int (< 2^53). Tests tuple returns with let-tuple
destructuring + recursion on n / 2.
86 baseline programs total.
Standard two-finger merge with nested match-in-match:
let rec merge xs ys =
match xs with
| [] -> ys
| x :: xs' ->
match ys with
| [] -> xs
| y :: ys' ->
if x <= y then x :: merge xs' (y :: ys')
else y :: merge (x :: xs') ys'
Used as a building block in merge_sort.ml (iter 104) but called out
as its own baseline here.
merge [1;4;7;10] [2;3;5;8;9] = [1;2;3;4;5;7;8;9;10]
length 9, sum 49, product 441.
85 baseline programs total.
Fast exponentiation by squaring with modular reduction:
let rec pow_mod base exp m =
if exp = 0 then 1
else if exp mod 2 = 0 then
let half = pow_mod base (exp / 2) m in
(half * half) mod m
else
(base * pow_mod base (exp - 1) m) mod m
Even exponent halves and squares (O(log n)); odd decrements and
multiplies. mod-reduction at each step keeps intermediates bounded.
pow_mod 2 30 1000003 + pow_mod 3 20 13 + pow_mod 5 17 100 = 738639
84 baseline programs total.
Same 'tree = Leaf | Node of int * tree * tree' ADT as iter-159
max_path_tree.ml, but the recursion ignores the value:
let rec depth t = match t with
| Leaf -> 0
| Node (_, l, r) ->
let dl = depth l in
let dr = depth r in
1 + (if dl > dr then dl else dr)
For the test tree:
1
/ 2 3
/ 4 5
/
8
longest path is 1 -> 2 -> 5 -> 8, depth = 4.
Tests wildcard pattern in constructor 'Node (_, l, r)', two nested
let-bindings in match arm, inline if-as-expression for max.
83 baseline programs total.
Walk input with Hashtbl.mem + Hashtbl.add seen x () (unit-payload
turns the table into a set); on first occurrence cons to the result
list; reverse at the end:
let stable_unique xs =
let seen = Hashtbl.create 8 in
let result = ref [] in
List.iter (fun x ->
if not (Hashtbl.mem seen x) then begin
Hashtbl.add seen x ();
result := x :: !result
end
) xs;
List.rev !result
For [3;1;4;1;5;9;2;6;5;3;5;8;9]:
result = [3;1;4;5;9;2;6;8] (input order, dupes dropped)
length = 8, sum = 38 total = 46
Tests Hashtbl as a set abstraction (unit-payload), the rev-build
idiom, and 'not (Hashtbl.mem seen x)' membership negation.
82 baseline programs total.
Inverse of run_length.ml from iteration 130. Takes a list of
(value, count) tuples and expands:
let rec rle_decode pairs =
match pairs with
| [] -> []
| (x, n) :: rest ->
let rec rep k = if k = 0 then [] else x :: rep (k - 1) in
rep n @ rle_decode rest
rle_decode [(1,3); (2,2); (3,4); (1,2)]
= [1;1;1; 2;2; 3;3;3;3; 1;1]
sum = 3 + 4 + 12 + 2 = 21.
Tests tuple-cons pattern, inner-let recursion, list concat (@), and
the 'List.fold_left (+) 0' invariant on encoding round-trips.
81 baseline programs total.
Defines unary Peano numerals with two recursive functions for
arithmetic:
type peano = Zero | Succ of peano
let rec plus a b = match a with
| Zero -> b
| Succ a' -> Succ (plus a' b)
let rec mul a b = match a with
| Zero -> Zero
| Succ a' -> plus b (mul a' b)
mul is defined inductively: mul Zero _ = Zero; mul (Succ a) b =
b + (a * b).
to_int (mul (from_int 5) (from_int 6)) = 30
The result is a Peano value with 30 nested Succ wrappers; to_int
unrolls them to a host int. Tests recursive ADT with a single-arg
constructor + four mutually-defined recursive functions (no rec/and
needed since each is defined separately).
80 baseline programs total — milestone.
Companion to coin_change.ml (min coins). Counts distinct multisets
via the unbounded-knapsack DP:
let count_ways coins target =
let dp = Array.make (target + 1) 0 in
dp.(0) <- 1;
List.iter (fun c ->
for i = c to target do
dp.(i) <- dp.(i) + dp.(i - c)
done
) coins;
dp.(target)
Outer loop over coins, inner DP relaxes dp.(i) += dp.(i - c). The
order matters — coin in outer, amount in inner — to count multisets
rather than ordered sequences.
count_ways [1; 2; 5; 10; 25] 50 = 406.
79 baseline programs total.
One-pass walk tracking current depth and a high-water mark:
let max_depth s =
let d = ref 0 in
let m = ref 0 in
for i = 0 to String.length s - 1 do
if s.[i] = '(' then begin
d := !d + 1;
if !d > !m then m := !d
end
else if s.[i] = ')' then d := !d - 1
done;
!m
Three inputs:
'((1+2)*(3-(4+5)))' 3 (innermost (4+5) at depth 3)
'(((deep)))' 3
'()()()' 1 (no nesting)
sum 7
Tests for-loop char comparison s.[i] = '(' and the high-water-mark
idiom with two refs.
78 baseline programs total.
Each pass:
1. find_max in [0..size-1]
2. if max not at the right end, flip max to position 0 (if needed)
3. flip the size-prefix to push max to the end
Inner 'flip k' reverses prefix [0..k] using two pointer refs lo/hi.
Inner 'find_max k' walks 1..k tracking the max-position.
pancake_sort [3;1;4;1;5;9;2;6]
= 9 flips * 100 + a.(0) + a.(n-1)
= 9 * 100 + 1 + 9
= 910
The output combines flip count and sorted endpoints, so the test
verifies both that the sort terminates and that it sorts correctly.
Tests two inner functions closing over the same Array, ref-based
two-pointer flip, and downto loop with conditional flip dispatch.
77 baseline programs total.
Iterative two-ref Fibonacci with modular reduction every step:
let fib_mod n m =
let a = ref 0 in
let b = ref 1 in
for _ = 1 to n do
let c = (!a + !b) mod m in
a := !b;
b := c
done;
!a
The 100th Fibonacci is 354_224_848_179_261_915_075, well past JS
safe-int (2^53). Modular reduction every step keeps intermediate
values within int53 precision so the answer is exact in our
runtime. fib(100) mod 1000003 = 391360.
76 baseline programs total.
Walks digits right-to-left, doubles every other starting from the
second-from-right; if a doubled value > 9, subtract 9. Sum must be
divisible by 10:
let luhn s =
let n = String.length s in
let total = ref 0 in
for i = 0 to n - 1 do
let d = Char.code s.[n - 1 - i] - Char.code '0' in
let v = if i mod 2 = 1 then
let dd = d * 2 in
if dd > 9 then dd - 9 else dd
else d
in
total := !total + v
done;
!total mod 10 = 0
Test cases:
'79927398713' valid
'79927398710' invalid
'4532015112830366' valid (real Visa test)
'1234567890123456' invalid
sum = 2
Tests right-to-left index walk via 'n - 1 - i', Char.code '0'
arithmetic for digit conversion, and nested if-then-else.
75 baseline programs total.
Bottom-up DP minimum-path through a triangle:
2
3 4
6 5 7
4 1 8 3
let min_path_triangle rows =
initialise dp from last row;
for r = n - 2 downto 0 do
for c = 0 to row_len - 1 do
dp.(c) <- row.(c) + min(dp.(c), dp.(c+1))
done
done;
dp.(0)
The optimal path 2 -> 3 -> 5 -> 1 sums to 11.
Tests downto loop, Array.of_list inside loop body, nested arr.(i)
reads + writes, and inline if-then-else for min.
74 baseline programs total.
Recursive ADT for binary trees:
type tree = Leaf | Node of int * tree * tree
let rec max_path t =
match t with
| Leaf -> 0
| Node (v, l, r) ->
let lp = max_path l in
let rp = max_path r in
v + (if lp > rp then lp else rp)
For the test tree:
1
/ 2 3
/ \ \
4 5 7
paths sum: 1+2+4=7, 1+2+5=8, 1+3+7=11. max = 11.
Tests 3-arg Node constructor with positional arg destructuring, two
nested let-bindings, and if-then-else as an inline expression.
73 baseline programs total.
Extended Euclidean returns a triple (gcd, x, y) such that
a*x + b*y = gcd:
let rec ext_gcd a b =
if b = 0 then (a, 1, 0)
else
let (g, x1, y1) = ext_gcd b (a mod b) in
(g, y1, x1 - (a / b) * y1)
let mod_inverse a m =
let (_, x, _) = ext_gcd a m in
((x mod m) + m) mod m
Three invariants checked:
inv(3, 11) = 4 (3*4 = 12 = 1 mod 11)
inv(5, 26) = 21 (5*21 = 105 = 1 mod 26)
inv(7, 13) = 2 (7*2 = 14 = 1 mod 13)
sum = 27
Tests recursive triple-tuple return, tuple-pattern destructuring on
let-binding (with wildcard for unused fields), and nested
let-binding inside the recursive call site.
72 baseline programs total.
Three small functions:
hist xs build a Hashtbl of count-by-value
max_value h Hashtbl.fold to find the max bin
total h Hashtbl.fold to sum all bins
For the 15-element list [1;2;3;1;4;5;1;2;6;7;1;8;9;1;0]:
total = 15
max_value = 5 (the number 1 appears 5 times)
product = 75
Companion to bag.ml (string keys) and frequency.ml (char keys) —
same Hashtbl.fold + Hashtbl.find_opt pattern, exercised on int
keys this time.
71 baseline programs total.
Standard amortising-mortgage formula:
payment = P * r * (1 + r)^n / ((1 + r)^n - 1)
where r = annual_rate / 12, n = years * 12.
let payment principal annual_rate years =
let r = annual_rate /. 12.0 in
let n = years * 12 in
let pow_r = ref 1.0 in
for _ = 1 to n do pow_r := !pow_r *. (1.0 +. r) done;
principal *. r *. !pow_r /. (!pow_r -. 1.0)
For 200,000 at 5% over 30 years: monthly payment ~= $1073.64,
int_of_float -> 1073.
Manual (1+r)^n via for-loop instead of Float.pow keeps the program
portable to any environment where pow is restricted.
Tests float arithmetic precedence, for-loop accumulation in a float
ref, int_of_float on the result.
70 baseline programs total — milestone.
One-liner that swaps the lists on every recursive call:
let rec zigzag xs ys =
match xs with
| [] -> ys
| x :: xs' -> x :: zigzag ys xs'
This works because each call emits the head of xs and recurses with
ys as the new xs and the rest of xs as the new ys.
zigzag [1;3;5;7;9] [2;4;6;8;10] = [1;2;3;4;5;6;7;8;9;10] sum = 55
Tests recursive list cons + arg-swap idiom that is concise but
non-obvious to readers expecting symmetric-handling.
68 baseline programs total.
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.
