Original bug ID: 6552
Reporter: ybarnoy
Assigned to: @yallop
Status: closed (set by @yallop on 2014-09-10T22:22:57Z)
Resolution: not a bug
Priority: normal
Severity: major
Version: 4.02.0+beta1 / +rc1
Category: back end (clambda to assembly)

Bug description

I have code that uses recursive modules quite heavily. In OrderedKey, if compare is left as is, it results in a runtime exception saying undefined recursive modules. If it's changed to 'let compare a b = ValueComp.compare_v a b' then the undefined module problem doesn't happen. This happens in 4.02 and 4.01.

I can't provide my full source code, but I can work on a simpler version that should illustrate the issue.

An excerpt of my code follows:

module rec OrderedKey : ICommon.OrderedKeyType = struct
type t = Value.value_t
let compare = ValueComp.compare_v
let hash = ValueComp.hash
let filter_idxs idxs = function
| Value.VTuple l -> Value.VTuple(list_filter_idxs idxs l)
| _ -> invalid_arg "not a vtuple"
end

and ValueMap : NearMap.S with type key = Value.value_t = NearMap.Make(OrderedKey)

and ValueBag : IBag.S with type elt = Value.value_t
and type t = int HashMap.Make(OrderedKey).t
= IBag.Make(OrderedKey)

and ValueMMap : IMultimap.S with type elt = Value.value_t
and type InnerBag.elt = Value.value_t
and type InnerBag.t = int HashMap.Make(OrderedKey).t
= IMultimap.Make(OrderedKey)

and ValueComp : (sig val compare_v : Value.value_t -> Value.value_t -> int
val hash : Value.value_t -> int
val reset_counter : unit -> unit
val get_counter : unit -> int
end) = struct
open Value
exception Mismatch of int
let counter = ref 0 (* for pinpointing errors *)

let get_counter () = !counter
let reset_counter () = counter := 0

let rec compare_v a b =
  incr counter;
  match a,b with
  | VTuple vs, VTuple vs' ->
      begin try
        List.iter2 (fun x y -> let r = compare_v x y in
                     if r <> 0 then raise (Mismatch r)) vs vs'; 0
      with Mismatch r -> r end
  | VOption(Some v), VOption(Some v') -> compare_v v v'
  | VSet v, VSet v' -> ISet.compare compare_v v v'
  | VBag v, VBag v' -> ValueBag.compare v v'
  | VList v, VList v' -> IList.compare compare_v v v'
  | VMap v, VMap v' -> ValueMap.compare compare_v v v'
  | VMultimap v, VMultimap v' -> ValueMMap.compare_m v v'
  | VIndirect v, VIndirect v' -> compare_v !v !v'
  | x, y -> compare x y (* generic comparison *)

module IntMap : (Map.S with type key = int) = Map.Make(struct
  type t = int
  let compare x y = x - y
end)

(* try to get a consistent hashing scheme based on members *)
let rec hash v =
  (* hash members only *)
  let col_hash fold_fn v = fold_fn (fun acc x -> hash x lxor acc) 0 v in
  let map_hash fold_fn v = fold_fn (fun k v acc -> hash k lxor hash v lxor acc) v 0 in
  match v with
  | VTuple vs       -> col_hash List.fold_left vs
  | VOption(Some v) -> hash v
  | VIndirect v     -> hash !v
  | VSet v          -> col_hash ISet.fold v
  | VBag v          -> col_hash ValueBag.fold v
  | VList v         -> col_hash IList.fold v
  | VMap v          -> map_hash ValueMap.fold v
  | VMultimap v     -> col_hash ValueMMap.fold v
  | x               -> Hashtbl.hash x

end

and Value : sig
type eval_t = VDeclared of value_t ref
| VTemp of value_t

and foreign_func_t = env_t -> env_t * eval_t

(* mutable environment, frame environment *)
and env_t = (value_t ref) IdMap.t * value_t list IdMap.t

and value_t
= VUnknown
| VUnit
| VBool of bool
| VInt of int
| VFloat of float
| VByte of char
| VString of string
| VTuple of value_t list
| VOption of value_t option
| VSet of value_t ISet.t
| VBag of ValueBag.t
| VList of value_t IList.t
| VMap of value_t ValueMap.t
| VMultimap of ValueMMap.t
| VFunction of arg_t * expr_t
| VForeignFunction of arg_t * foreign_func_t
| VAddress of address
| VTarget of id_t
| VIndirect of value_t ref
end = Value

open Value