atdj_util.ml

(* Utilities *)

open Printf
open Atdj_env

(* Get rid of `wrap' constructors that we don't support on the Java side yet.
   They could be useful for timestamps, though. *)
let rec unwrap atd_ty =
  match atd_ty with
  | `Wrap (_, x, _) -> unwrap x
  | x -> x

let rec unwrap_option env atd_ty =
  match atd_ty with
  | `Wrap (_, x, _) -> unwrap_option env x
  | `Option (_, x, _) -> unwrap_option env x
  | x -> x

(* Normalise an ATD type by expanding `top-level' type aliases *)
let rec norm_ty ?(unwrap_option = false) env atd_ty =
  let atd_ty = unwrap atd_ty in
  match atd_ty with
    | `Name (_, (_, name, _), _) ->
        (match name with
           | "bool" | "int" | "float" | "string" | "abstract" -> atd_ty
           | _ ->
               (try
                  let x = List.assoc name env.module_items in
                  norm_ty env x
                with Not_found ->
                  eprintf "Warning: unknown type %s\n%!" name;
                  atd_ty
               )
        )
    | `Option (_, atd_ty, _) when unwrap_option ->
        norm_ty env atd_ty
    | _ ->
        atd_ty

let not_supported loc =
  Atd_ast.error_at loc "Construct not yet supported by atdj."

let type_not_supported x =
  let loc = Atd_ast.loc_of_type_expr x in
  Atd_ast.error_at loc "Type not supported by atdj."

let warning loc msg =
  let loc_s = Atd_ast.string_of_loc loc in
  eprintf "\
Warning:
%s
%s
%!"
    loc_s
    msg

(*
   Insert given string ind_S at the beginning of each line from string s.
*)
let indent_block_s =
  let rex = Str.regexp "^" in
  fun ins s ->
    Str.global_replace rex ins s

(*
   Insert n spaces at the beginning of each line from string s.
*)
let indent_block n s =
  let ins = String.make n ' ' in
  indent_block_s ins s