2012-06-27 18:09:30 +02:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Heptagon *)
|
|
|
|
(* *)
|
|
|
|
(* Gwenael Delaval, LIG/INRIA, UJF *)
|
|
|
|
(* Leonard Gerard, Parkas, ENS *)
|
|
|
|
(* Adrien Guatto, Parkas, ENS *)
|
|
|
|
(* Cedric Pasteur, Parkas, ENS *)
|
2012-06-29 01:43:15 +02:00
|
|
|
(* Marc Pouzet, Parkas, ENS *)
|
2012-06-27 18:09:30 +02:00
|
|
|
(* *)
|
|
|
|
(* Copyright 2012 ENS, INRIA, UJF *)
|
|
|
|
(* *)
|
|
|
|
(* This file is part of the Heptagon compiler. *)
|
|
|
|
(* *)
|
|
|
|
(* Heptagon is free software: you can redistribute it and/or modify it *)
|
|
|
|
(* under the terms of the GNU General Public License as published by *)
|
|
|
|
(* the Free Software Foundation, either version 3 of the License, or *)
|
|
|
|
(* (at your option) any later version. *)
|
|
|
|
(* *)
|
|
|
|
(* Heptagon is distributed in the hope that it will be useful, *)
|
|
|
|
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
|
|
|
|
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
|
|
|
|
(* GNU General Public License for more details. *)
|
|
|
|
(* *)
|
|
|
|
(* You should have received a copy of the GNU General Public License *)
|
|
|
|
(* along with Heptagon. If not, see <http://www.gnu.org/licenses/> *)
|
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
2011-11-22 11:39:25 +01:00
|
|
|
open Types
|
|
|
|
|
|
|
|
exception Bad_format
|
|
|
|
|
2011-11-22 14:43:52 +01:00
|
|
|
type token = Modifier of string | Literal of string
|
|
|
|
type format = token list
|
|
|
|
|
2011-11-22 11:39:25 +01:00
|
|
|
let tail s start =
|
|
|
|
String.sub s start (String.length s - start)
|
|
|
|
|
|
|
|
(** Return a list of expected types from a format string *)
|
2011-11-22 14:43:52 +01:00
|
|
|
let rec format_of_string s =
|
2011-11-22 11:39:25 +01:00
|
|
|
try
|
|
|
|
let i = String.index s '%' in
|
2011-11-22 14:43:52 +01:00
|
|
|
let l = format_of_string (tail s (i+2)) in
|
|
|
|
if i = 0 then
|
2012-10-31 15:56:06 +01:00
|
|
|
let modifier = String.sub s 1 1 in
|
2011-11-22 14:43:52 +01:00
|
|
|
(Modifier modifier)::l
|
|
|
|
else
|
|
|
|
let lit = String.sub s 0 i in
|
|
|
|
let modifier = String.sub s (i+1) 1 in
|
|
|
|
(Literal lit)::(Modifier modifier)::l
|
2011-11-22 11:39:25 +01:00
|
|
|
with
|
|
|
|
| Invalid_argument _ -> raise Bad_format (* String.get failed*)
|
2011-11-22 14:43:52 +01:00
|
|
|
| Not_found -> [Literal s]
|
|
|
|
|
|
|
|
let types_of_format_string s =
|
|
|
|
let ty_of_format f acc = match f with
|
|
|
|
| Modifier "b" -> Initial.tbool::acc
|
|
|
|
| Modifier "d" -> Initial.tint::acc
|
|
|
|
| Modifier "f" -> Initial.tfloat::acc
|
2012-10-31 15:56:06 +01:00
|
|
|
| Modifier "s" -> Initial.tstring::acc
|
2011-11-22 14:43:52 +01:00
|
|
|
| _ -> acc
|
|
|
|
in
|
|
|
|
let sl = format_of_string s in
|
|
|
|
List.fold_right ty_of_format sl []
|
|
|
|
|
|
|
|
let tr_format f s =
|
|
|
|
let aux tok acc = match tok with
|
|
|
|
| Literal s -> s^acc
|
|
|
|
| Modifier m -> "%"^(f m)^acc
|
|
|
|
in
|
|
|
|
let sl = format_of_string s in
|
|
|
|
List.fold_right aux sl ""
|