[Caml-list] Odd failure to infer types

[Goswin von Brederlow <goswin-v-b@web.de>]

Hi,

I'm implementing a solver for the game Atomix. If you don't know it then
don't worry. It isn't relevant.

I split things up into submodules and now one of the submodules does not
infere the right types:

File "Atomix.ml", line 168, characters 11-876:
Error: The type of this module,
       sig
         type dir = NORTH | SOUTH | WEST | EAST
         val max_moves : int
         val cache : (string, unit) Hashtbl.t
         val states :
           ('_a list * (char * int * int) array * string) list array
         val string_of_dir : dir -> string
         val print :
           (int * int * dir) list * (char * int * int) array * string -> unit
         val num_states : int
       end, contains type variables that cannot be generalized

I believe this is wrong. In S.num_states the call to "print state"
fixates the type for state and the "states.(d) <- state::states.(d);"
should then fixate the missing '_a in the type for states.

Anyone know why?

MfG
        Goswin

----------------------------------------------------------------------
module B = struct
  exception Outside
  let width = 14
  let height = 6
  let board = ""
    ^ "  #         # "
    ^ "  #         # "
    ^ "  #           "
    ^ "  # #  #######"
    ^ "    #         "
    ^ "    #         "

  let start =
    Array.of_list
      (List.sort compare
	 [
	   ('A',  1, 3); (*  H- *)
	   ('B', 10, 5); (* -O- *)
	   ('C', 13, 1); (* -H  *)
	 ])

  let get board x y =
    if (x < 0) || (x >= width) || (y < 0) || (y >= height)
    then '#'
    else board.[x + y * width]

  let set board x y c =
    if (x < 0) || (x >= width) || (y < 0) || (y >= height)
    then raise Outside;
    let board = String.copy board
    in
    board.[x + y * width] <- c;
    board

  let print board =
    Printf.printf "  ";
    for x = 0 to width - 1 do
      Printf.printf "%c" (char_of_int (int_of_char 'A' + x));
    done;
    Printf.printf "\n";
    Printf.printf " +--------------+\n";
    for y = 0 to height - 1 do
      Printf.printf "%d|" (y + 1);
      for x = 0 to width - 1 do
	Printf.printf "%c" board.[y * width + x];
      done;
      Printf.printf "|\n";
    done;
    Printf.printf " +--------------+\n";
    flush_all ()
end

module G = struct
  let width = 3
  let height = 1
  let atoms = "ABC"

  let get x y =
    if (x < 0) || (x >= width) || (y < 0) || (y >= height)
    then '~'
    else atoms.[x + y * width]
    
  let solutions =
    let rec loopy acc = function
      | -1 -> acc
      | y ->
	let rec loopx acc = function
	  | -1 -> loopy acc (y - 1)
	  | x ->
	    let rec loopv acc sol board = function
	      | -1 ->
		B.print board;
		let sol = Array.of_list (List.sort compare sol)
		in
		loopx ((sol, board)::acc) (x - 1)
	      | v ->
		let rec loopu acc sol board = function
		  | -1 -> loopv acc sol board (v - 1)
		  | u ->
		    let c = get u v
		    in
		    if c = ' '
		    then loopu acc sol board (u - 1)
		    else if B.get board (x + u) (y + v) = ' '
		    then
		      begin
			let board = B.set board (x + u) (y + v) c
			in
			loopu acc ((c, x + u, y + v)::sol) board (u - 1)
		      end
		    else loopx acc (x - 1) 
		in
		loopu acc sol board (width - 1)
	    in
	    loopv acc [] B.board (height - 1)
	in
	loopx acc (B.width - width)
    in
    loopy [] (B.height - height)

  let print (sol, board) =
    B.print board;
    Array.iter
      (fun (c, x, y) ->
	Printf.printf "%c: (%c, %d)\n" c
	  (char_of_int (int_of_char 'A' + x))
	  (y + 1))
      sol;
    flush_all ()
end

module D = struct
  let infty = 999999
  let make_one x y =
    let d = Array.make_matrix B.width B.height infty in
    let rec loop n acc = function
      | [] ->
	if acc = []
	then d
	else loop (n + 1) [] acc
      | (u, v)::xs ->
	let rec move acc x y dx dy =
	  if B.get B.board x y = ' '
	  then
	    let acc =
	      if d.(x).(y) > n
	      then
		begin
		  d.(x).(y) <- n;
		  (x, y)::acc
		end
	      else acc
	    in
	    move acc (x + dx) (y + dy) dx dy
	  else acc
	in
	let acc = move acc u v (-1) 0 in
	let acc = move acc u v 1 0 in
	let acc = move acc u v 0 (-1) in
	let acc = move acc u v 0 1
	in
	loop n acc xs
    in
    d.(x).(y) <- 0;
    loop 1 [] [(x, y)]

  let dist =
    Array.init B.width (fun x -> Array.init B.height (fun y -> make_one x y))

  let get x1 y1 x2 y2 =
    if (x1 < 0) || (x1 >= B.width) || (y2 < 0) || (y2 >= B.height)
      || (x2 < 0) || (x2 >= B.width) || (y2 < 0) || (y2 >= B.height)
    then infty
    else dist.(x1).(y1).(x2).(y2)

  let get_all pos =
    let d =
      Array.mapi
	(fun i (c, x1, y1) ->
	  let (_, x2, y2) = B.start.(i)
	  in
	  get x1 y1 x2 y2)
	pos
    in
    Array.fold_left ( + ) 0 d
end

module S = struct
  type dir = NORTH | SOUTH | WEST | EAST

  let max_moves = 1000
  let cache = Hashtbl.create 0
    (*
  let states = ((Array.make max_moves []) :
      ((int * int * dir) list * (char * int * int) array * string) list array)
    *)
  let states = Array.make max_moves []

  let string_of_dir = function
    | NORTH -> "norden"
    | SOUTH -> "sueden"
    | WEST -> "westen"
    | EAST -> "osten"
      
  let print (moves, (_ : (char * int * int) array), board) =
    B.print board;
    List.iter
      (fun (x, y, dir) ->
	Printf.printf "zug %c %d %s,"
	  (char_of_int (int_of_char 'A' + x))
	  (y + 1)
	  (string_of_dir dir))
      moves

  let num_states =
    List.fold_left
      (fun num (sol, board) ->
	let d = D.get_all sol in
	let state = ([], sol, board)
	in
	Hashtbl.add cache board ();
	states.(d) <- state::states.(d);
	print state;
	num + 1)
      0
      G.solutions
end

let () =
  List.iter G.print G.solutions;
  Printf.printf "%d solutions\n" (List.length G.solutions)