/[svn]/cduce/trunk/ocamliface/mlstub.ml
ViewVC logotype

Diff of /cduce/trunk/ocamliface/mlstub.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1956 by abate, Wed Jul 11 13:01:15 2007 UTC revision 4020 by jmaloberti, Sun Sep 26 07:23:36 2010 UTC
# Line 37  Line 37 
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 ->
# Line 393  Line 403 
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

Legend:
Removed from v.1956  
changed lines
  Added in v.4020

CVS Admin">CVS Admin
ViewVC Help
Powered by ViewVC 1.1.5