Sudoku algorithm, anybody?

exception Sudoku_exception of string;;let rec remove_first lst item =    match lst with        []                  -> []      | h::t when h == item -> t      | h::t                -> h :: remove_first t item;;let rec range a b =    if a <= b    then a :: range (a + 1) b    else [];;module Position =(    struct	type t = { x:int; y:int }	let create x y = { x = x; y = y }	let x p = p.x	let y p = p.y	let xy p = (p.x, p.y)	let print p = Printf.printf "(%d, %d)" p.x p.y	let compare p q =	    if p.x < q.x	    then -1	    else if p.x > q.x	    then 1	    else if p.y < q.y	    then -1	    else if p.y > q.y	    then 1	    else 0    end    :    sig	type t	val create : int -> int -> t	val x      : t -> int	val y      : t -> int	val xy     : t -> int * int	val print  : t -> unit	val compare : t -> t -> int    end);;module PositionSet = Set.Make(Position);;module Grid =(    struct    type cell = Certain of int	      | Choice of int list    type grid = cell array array    let create () =        let result = Array.make_matrix 9 9 (Certain 0)	in	for i = 0 to 8 do	    for j = 0 to 8 do		result.(i).(j) <- Choice [1;2;3;4;5;6;7;8;9]	    done        done;	result;;    let copy grid =	let copy_row idx =	    Array.copy grid.(idx)        in	Array.init 9 copy_row;;    let cluster_cells pos =	let result = ref PositionSet.empty	and (x,y) = Position.xy pos	in	let add x y =	    result := PositionSet.add (Position.create x y) !result        in	for i = 0 to 8 do	    if x <> i	    then add i y	    else ();	    if y <> i	    then add x i        done;		let sx = (x / 3) * 3	and sy = (y / 3) * 3	in	for i = 0 to 2 do	    for j = 0 to 2 do		let x' = sx + i		and y' = sy + j		in		if x' != x || y' != y		then add x' y'	    done        done;	!result;;    let get (grid : grid) pos =        let (x, y) = Position.xy pos	in	grid.(x).(y);;    let set grid pos n =	let (x,y) = Position.xy pos	in	let remove_choice pos =	    let (x, y) = Position.xy pos	    in	    match grid.(x).(y) with	        Certain _  -> ()              | Choice lst -> grid.(x).(y) <- Choice (remove_first lst n)        and influenced_cells = cluster_cells pos	in	match grid.(x).(y) with            Certain _ 	        -> raise (Sudoku_exception "Cell already certain")          | Choice lst when not (List.mem n lst)	        -> raise (Sudoku_exception "Not in choice list")          | Choice lst                -> (	               PositionSet.iter remove_choice influenced_cells;		       grid.(x).(y) <- Certain n	           );;    let normalize grid =        let continue = ref true	in	while !continue do	    continue := false;	    for i = 0 to 8 do	        for j = 0 to 8 do		    match grid.(i).(j) with		        Choice [x] -> set grid (Position.create i j) x;				      continue := true                      | _          -> ()		done	    done	done;;    let print grid =        for j = 0 to 8 do	    for i = 0 to 8 do	        match grid.(i).(j) with		    Certain x -> print_int x                  | Choice _  -> print_string "."	    done;	    print_newline ()	done    let find_least_choice grid =	let count = ref 10	and x = ref 0	and y = ref 0	in	let check i j lst =	    let len = List.length lst	    in	    if !count >= len	    then (	             x := i;		     y := j;		     count := len	         )        in	for i = 0 to 8 do	    for j = 0 to 8 do		match get grid (Position.create i j) with	            Choice lst -> check i j lst                  | _          -> ()	    done        done;	match grid.(!x).(!y) with	      Choice _ -> Some (Position.create !x !y)	    | _        -> None        end    :    sig        type cell = Certain of int		  | Choice of int list        type grid	val create : unit -> grid	val copy   : grid -> grid	val get : grid -> Position.t -> cell	val set : grid -> Position.t -> int -> unit	val normalize : grid -> unit		val print : grid -> unit	val find_least_choice : grid -> Position.t option	    end);;let load_grid file =    let input = open_in file    and grid = Grid.create ()    and x = ref 0    and y = ref 0    in    let next () =        x := !x + 1;	if !x == 9	then ( x := 0; y := !y + 1)    and finished () =        !x == 0 && !y == 9    in    let add_unknown () =        next ()    and add_certain n =        Grid.set grid (Position.create !x !y) n;	next ()    and digit_of_char c =        int_of_char c - int_of_char '0'    in    while not (finished ()) do        let c = input_char input	in	match c with	      '.'        -> add_unknown ()	    | '0' .. '9' -> add_certain (digit_of_char c)	    | _		 -> ()    done;    close_in input;    grid;;let rec solve grid =    let grid = Grid.copy grid    in    let rec find_first func lst =        match lst with	    []   -> None          | h::t -> (		        let result = func h			in			match result with			    None   -> find_first func t                          | Some x -> result                    )    in    let branch_at pos =	let solve_with n =	    let grid = Grid.copy grid	    in	    Grid.set grid pos n;	    solve grid        in        match Grid.get grid pos with            Grid.Certain _ -> raise (Sudoku_exception "Unexpected error")          | Grid.Choice opts -> find_first solve_with opts    in    Grid.normalize grid;    match Grid.find_least_choice grid with        None     -> Some grid      | Some pos -> branch_at pos;;