> Exercise to the interested reader:
> Define a function which, given a string and a concrete representation
> of its format type, checks whether the string conforms to the type.
> To make it more useful, the concrete representation used should
> include the format type in its type, using phantom types.
> 
> val check_format : ('a, 'b) format_type -> string -> bool
> val make_format : ('a, 'b) format_type -> string -> ('a, 'c, 'b) format
> 
> # make_format (arr string (arr int (arr int null))) "Hello %s, it's %d:%d.\n";;
> val fmt : (string -> int -> int -> 'a, 'b, 'a) format = <abstr>

Since nobody answered to the challenge, here is a solution (only
partial, qualifiers are not supported).

Syntax slightly differs.

# open Checkfmt;;
# check_printf (apply (int null)) "Price is %a or %i.\n"
    (fun c -> Printf.fprintf c "%f") 1.2 3;;
Price is 1.200000 or 3.
- : unit = ()

Here is the code. Note that I use Obj.magic only once.

module Checkfmt : sig
  type ('a, 'b, 'c) format_type
  val null : ('a, 'b, 'a) format_type
  val int : ('a, 'b, 'c) format_type -> (int -> 'a, 'b, 'c) format_type
  val string :
      ('a, 'b, 'c) format_type -> (string -> 'a, 'b, 'c) format_type
  val char : ('a, 'b, 'c) format_type -> (char -> 'a, 'b, 'c) format_type
  val float : ('a, 'b, 'c) format_type -> (float -> 'a, 'b, 'c) format_type
  val bool : ('a, 'b, 'c) format_type -> (bool -> 'a, 'b, 'c) format_type
  val apply :
      ('a, 'b, 'c) format_type ->
      (('b -> 'd -> 'c) -> 'd -> 'a, 'b, 'c) format_type
  val output :
      ('a, 'b, 'c) format_type -> (('b -> 'c) -> 'a, 'b, 'c) format_type
  val check_format : ('a, 'b, 'c) format_type -> string -> bool
  val make_format : ('a, 'b, 'c) format_type -> string -> ('a, 'b, 'c) format
  val check_printf : ('a, out_channel, unit) format_type -> string -> 'a
end = struct
type ('a,'b, 'c) format_type =
    Null
  | Int of ('a, 'b, 'c) format_type
  | String of ('a, 'b, 'c) format_type
  | Char of ('a, 'b, 'c) format_type
  | Float of ('a, 'b, 'c) format_type
  | Bool of ('a, 'b, 'c) format_type
  | Apply of ('a, 'b, 'c) format_type
  | Output of ('a, 'b, 'c) format_type

let null : ('a, 'b, 'a) format_type = Null
let int (x : ('a, 'b, 'c) format_type) =
  (Int x :> (int -> 'a, 'b, 'c) format_type)
let string (x : ('a, 'b, 'c) format_type) =
  (String x :> (string -> 'a, 'b, 'c) format_type)
let char (x : ('a, 'b, 'c) format_type) =
  (Char x :> (char -> 'a, 'b, 'c) format_type)
let float (x : ('a, 'b, 'c) format_type) =
  (Float x :> (float -> 'a, 'b, 'c) format_type)
let bool (x : ('a, 'b, 'c) format_type) =
  (Bool x :> (bool -> 'a, 'b, 'c) format_type)
let apply (x : ('a, 'b, 'c) format_type) =
  (Apply x :> (('b -> 'd -> 'c) -> 'd -> 'a, 'b, 'c) format_type)
let output (x : ('a, 'b, 'c) format_type) =
  (Apply x :> (('b -> 'c) -> 'a, 'b, 'c) format_type)

let check_format fmtype fmt =
  let rec check pos fmtype =
    if pos >= String.length fmt then fmtype = Null else
    try
      let pos = String.index_from fmt pos '%' + 1 in
      if pos >= String.length fmt then invalid_arg "check_format";
      let c = fmt.[pos] in
      match c, fmtype with
        '%', _ -> check (pos+1) fmtype
      | ('d'|'i'|'u'|'x'|'X'|'o'), Int fmtype -> check (pos+1) fmtype
      | 's', String fmtype -> check (pos+1) fmtype
      | 'c', Char fmtype -> check (pos+1) fmtype
      | ('f'|'e'|'E'|'g'|'G'), Float fmtype -> check (pos+1) fmtype
      | 'b', Bool fmtype -> check (pos+1) fmtype
      | 'a', Apply fmtype -> check (pos+1) fmtype
      | 't', Output fmtype -> check (pos+1) fmtype
      | _ -> false
    with Not_found ->
      fmtype = Null
  in
  check 0 fmtype

let make_format (fmtype : ('a,'b,'c) format_type) fmt =
  if check_format fmtype fmt then (Obj.magic fmt : ('a,'b,'c) format)
  else failwith "make_format"

let check_printf fmtype fmt =
  Printf.printf (make_format fmtype fmt)
end
-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners