summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGuillaume Seguin <guillaume@segu.in>2009-01-23 16:06:58 +0100
committerGuillaume Seguin <guillaume@segu.in>2009-01-23 16:06:58 +0100
commit03fcaf6c0a17a51899308067081050c917c00e0c (patch)
tree8890a8c2bbfd119b604050b2d0ecb448ad1d0c14
parente2422918885ad440b226651e6432ec207d0c9347 (diff)
downloadpetitcaml-03fcaf6c0a17a51899308067081050c917c00e0c.tar.gz
petitcaml-03fcaf6c0a17a51899308067081050c917c00e0c.tar.bz2
[petitcaml] Improve type printingHEADmaster
-rw-r--r--typing.ml21
1 files changed, 14 insertions, 7 deletions
diff --git a/typing.ml b/typing.ml
index 6ee453b..8ffbf36 100644
--- a/typing.ml
+++ b/typing.ml
@@ -30,10 +30,19 @@ let rec canon t =
| Tlist t -> Tlist (canon t)
| t -> t
+(* Petit formateur récursif *)
+let rec get_tvar_string i =
+ let base = Printf.sprintf "%c" (char_of_int (97 + (i mod 26)))
+ in
+ if i >= 26 then
+ (get_tvar_string (i/26 - 1)) ^ base
+ else
+ base
+
(* Pour le debug et les erreurs : produit la représentation canonique d'un
type sous forme de chaîne de caractères *)
let canon_string t tvar_names =
- let next_tvar_char = ref 97
+ let next_tvar_char = ref 0
and tvar_names = ref tvar_names
in
let rec aux t =
@@ -44,12 +53,11 @@ let canon_string t tvar_names =
| Tbool -> "bool"
| Tarrow (t1, t2) -> aux_arrow t1 t2
| Tproduct (t::l) ->
- Printf.sprintf "%s"
- (List.fold_left (fun base t ->
+ List.fold_left (fun base t ->
Printf.sprintf "%s * %s"
base (aux t))
- (aux t)
- l)
+ (aux t)
+ l
| Tproduct _ -> failwith "canon_string : Unreachable matching"
| Tlist t ->
Printf.sprintf "%s list" (aux_list t)
@@ -57,8 +65,7 @@ let canon_string t tvar_names =
try
Imap.find tvar.id !tvar_names
with Not_found ->
- let tvar_name =
- (Printf.sprintf "'%c" (char_of_int !next_tvar_char))
+ let tvar_name = "'" ^ (get_tvar_string !next_tvar_char)
in
incr next_tvar_char;
tvar_names := Imap.add tvar.id