let query_parameters db query =
    let params = Hashtbl.create 13 in
    let bad state = raise (Bad_query state) in
    let add_param name colopt =
      try
        ignore (Hashtbl.find params name)
        (* FIXME: check that types/colums are identical ? *)
      with
        Not_found ->
          Hashtbl.add params name colopt
    in
    let table_by_name s =
      try table_by_name db s
      with Not_found ->
        let msg = Printf.sprintf "No table %s in schema" s in
        bad (Query_invalid_against_schema msg)
    in

    let env_from_from =
      let f acc t =
        let (name,t) = match t with
          `table s -> (s, table_by_name s)
        | `tableas (s1,s2) ->
            let t = table_by_name s1 in
            (s2, t)
        in
        if List.exists (fun (s,_) -> s = name) acc then
          let msg = Printf.sprintf
              "No unique table name %s in from clause" name
          in
          bad (Query_incorrect msg)
        else
          (name,t) :: acc
      in
      List.fold_left f
    in
    let get_column env = function
        `ref s ->
          let l = List.fold_left
              (fun acc (table,t) ->
                match column_by_name_opt t s with
                  None -> acc
                | Some c -> (table,c)::acc)
              []
              env
          in
          (
           match l with
             [] ->
               let msg = Printf.sprintf "Unbound column name %s" s in
               bad (Query_invalid_against_schema msg)
           | [(_,c)] -> c
           | _ :: _ :: _ ->
               let msg = Printf.sprintf
                   "Ambiguous column name %s; could belong to %s"
                   s (String.concat ", " (List.map fst l))
               in
               bad (Query_invalid_against_schema msg)
          )
      |        `refdotref (s1,s2) ->
          try
            let t = List.assoc s1 env in
            column_by_name t s2
          with
            Not_found ->
              let msg = Printf.sprintf "Unbound column name %s.%s" s1 s2 in
              bad (Query_invalid_against_schema msg)
    in
    let check_column env c = ignore (get_column env c) in
    let rec in_query_exp env = function
        `select s -> in_select env s
      |        `union (q1,q2) ->
          (in_query_exp env q1) @ (in_query_exp env q2)
      |        `unionall (q1,q2) ->
          (in_query_exp env q1) @ (in_query_exp env q2)
    and in_select env (_mod,selection,from,where_opt,group_by_opt,having_opt) =
      let env = env_from_from env from in
      let return_type =
        match selection with
          `star -> bad (Query_incorrect "'*' not supported in selection")
        | `list l ->
            let f = function
                `column c -> Some (get_column env c)
              |        _ -> None
            in
            List.map f l
      in
      (match where_opt with None -> () | Some w -> in_condition env w);
      (match group_by_opt with None -> () | Some g -> in_group_by env g);
      (match having_opt with None -> () | Some h -> in_condition env h);
      return_type
    and in_group_by env l = List.iter (check_column env) l
    and in_condition env = function
        `cand (c1, c2)
      |        `cor (c1, c2) -> in_condition env c1; in_condition env c2
      |        `cnot c -> in_condition env c
      |        `p p -> in_predicate env p
    (* FIXME: improve analysis of expressions to guess types of parameters *)
    and in_predicate env = function
        `comparisonexp (e1,_,e2) -> in_exp env e1; in_exp env e2
      |        `comparisonselect (e1,_,sel) ->
          in_exp env e1; ignore (in_select env sel)
      |        `between (_,e1,e2,e3) ->
          in_exp env e1; in_exp env e2; in_exp env e3
      |        `like (_,e1,a1,a2opt) ->
          in_exp env e1;
          in_atom env a1;
          (match a2opt with None -> () | Some a -> in_atom env a)
      |        `iscolnull (_,col) -> check_column env col
      |        `in_select (_,e1,sel) ->
          in_exp env e1; ignore (in_select env sel)
      |        `in_atom_list (_,e1,l) ->
          in_exp env e1; List.iter (in_atom env) l
      |        `allorany (e1,_,_,sel) ->
          in_exp env e1; ignore (in_select env sel)
      |        `exists sel -> ignore (in_select env sel)
    and in_exp env = function
        `binop (_,e1,e2) ->
          in_exp env e1; in_exp env e2
      |        `uminus e -> in_exp env e
      |        `atom a -> in_atom env a
      |        `column c -> check_column env c
      |        `functioncall _ ->
          (* FIXME: implement *)
          ()
    and in_atom env = function
        `parameter p -> in_parameter env p
      |        _ -> ()
    and in_parameter env = function
        `single s -> add_param s None
      |        `single_annotated (s,s2,s3) ->
          (
           try
             let t = table_by_name s2 in
             let col = column_by_name t s3 in
             add_param s (Some col)
           with
             Not_found ->
               let msg = Printf.sprintf "Unknown column %s.%s" s2 s3 in
               bad (Query_invalid_against_schema msg)
          )
      |        `couple _ ->
          bad (Query_incorrect "Don't know what to do with couple parameters")
      |        `indicator _ ->
          bad (Query_incorrect "Don't know what to do with indicator parameters")
    in
    let (qexp,ordlist) = query in
    let return_type = in_query_exp [] qexp in
    (* FIXME: handle ordering list *)
    (* FIXME: prevent parsing of capitalized parameters ? *)
    let params =
      Hashtbl.fold
        (fun name colopt acc -> (name,colopt)::acc)
        params
        []
    in
    let params = List.sort
        (fun (name1,_) (name2,_) -> Pervasives.compare name1 name2)
        params
    in
    (return_type, params)