| 37 |
(* Printf.eprintf "*** %S\n" s; *) |
(* Printf.eprintf "*** %S\n" s; *) |
| 38 |
aux 0 |
aux 0 |
| 39 |
|
|
| 40 |
|
let consId s = |
| 41 |
|
let rec aux i : Ast.ident = |
| 42 |
|
try |
| 43 |
|
let j = String.index_from s i '.' in |
| 44 |
|
<:ident< $uid:String.sub s i (j - i)$.$aux (j+1)$ >> |
| 45 |
|
with Not_found -> |
| 46 |
|
<:ident< $uid:String.sub s i (String.length s - i)$ >> |
| 47 |
|
in |
| 48 |
|
aux 0 |
| 49 |
|
|
| 50 |
let rec typ t = |
let rec typ t = |
| 51 |
try IntHash.find memo_typ t.uid |
try IntHash.find memo_typ t.uid |
| 52 |
with Not_found -> |
with Not_found -> |
| 403 |
let vars = mk_vars tl in |
let vars = mk_vars tl in |
| 404 |
let x = mk_var () in |
let x = mk_var () in |
| 405 |
<:match_case< ($str: String.escaped lab$, Some $lid:x$) -> |
<:match_case< ($str: String.escaped lab$, Some $lid:x$) -> |
| 406 |
$matches <:expr< $lid:x$ >> |
(* $matches <:expr< $lid:x$ >> |
| 407 |
<:expr< $id:id (p ^ lab)$ $tuple_to_ml tl vars$ >> |
<:expr< $id:id (p ^ lab)$ $tuple_to_ml tl vars$ >> |
| 408 |
|
vars$ >> *) |
| 409 |
|
$ matches |
| 410 |
|
<:expr< $lid:x$ >> ( |
| 411 |
|
List.fold_left |
| 412 |
|
(fun x (t, id) -> |
| 413 |
|
Ast.ExApp(_loc, x, <:expr<$to_ml <:expr< $lid:id$ >> t$>>)) |
| 414 |
|
<:expr< $id:consId (p ^ lab)$ >> |
| 415 |
|
(List.combine tl vars)) |
| 416 |
vars$ >> |
vars$ >> |
| 417 |
) l in |
) l in |
| 418 |
let cases = cases @ [ <:match_case< _ -> assert False >> ] in |
let cases = cases @ [ <:match_case< _ -> assert False >> ] in |