(*
 Hyunjun Eo

 Copyright(c) 2000-2004 KAIST/SNU Research On Program Analysis System
 (National Creative Research Initiative Center 1998-2003)
 http://ropas.snu.ac.kr/n

 All rights reserved. This file is distributed under the terms of
 an Open Source License.
*)

(* Based on Objective Caml Code                            *)

open String_ast.Ast

exception NotConvertible of string * Location.t
exception CombineError

let nloc = Location.none

let location_to_string loc =
  if String.length !(Location.input_name) = 0 then
    "Characters "^(string_of_int loc.Location.loc_start)^"-"^
    (string_of_int loc.Location.loc_end)^":"
  else begin
    let (filename,linenum,linebeg) =
          Linenum.for_position !(Location.input_name)
loc.Location.loc_start
    in
      "File \""^filename^"\", line "^(string_of_int linenum)^", characters "^
      (string_of_int (loc.Location.loc_start - linebeg))^"-"^
      (string_of_int (loc.Location.loc_end - linebeg))^":"
    end

(* for record *)

(*
let rec_count = ref (-1)
let new_rec () = (incr rec_count; "@rec_"^(string_of_int !rec_count))
*)

(* for data constructor *)

let con_count = ref (-1)
let new_con_ty () = (incr con_count; "@con_"^(string_of_int !con_count))

(* for valbind with tyvarseq *)

let valbind_tyvarseq = (ref [] : tyvar list ref)

let is_real e =
  match e with
    RealExp (_,_)
  | ConstraintExp(_,ConstTy([],([],("real",_),_),_),_)
  | SeqExp([RealExp (_,_)],_)
  | SeqExp([ConstraintExp(_,ConstTy([],([],("real",_),_),_),_)],_) ->
        true
  | _ -> false

let is_real_ref e =
  match e with
    ConstraintExp(_,ConstTy([ConstTy([],([],("real",_),_),_)],
                            ([],("ref",_),_),_),_)
  | SeqExp([ConstraintExp(_,ConstTy([ConstTy([],([],("real",_),_),_)],
                            ([],("ref",_),_),_),_)],_)
      -> true
  | _ -> false
 
 (* for ref pat *)

(*
let new_pat () = "Pat"

let rec subst_list f l = 
  let (s,l') = List.split (List.map f l) in (List.fold_left (@) [] s, l')

let rec subst_labpat (lbl,p,loc) = let (s,p') = subst_pat p in (s,(lbl,p',loc))

and subst_pat p =
  match p with
    RefPat(p1,l) -> let (s,p1') = subst_pat p1 in ((new_pat(),p1)::s,p1')
  | AppPat(lid,p1,l) -> let (s,p1') = subst_pat p1 in (s,AppPat(lid,p1',l))
  | RecordPat(lps,l) -> let (s,lps') = subst_list subst_labpat lps in
                        (s,RecordPat(lps',l))
  | SubRecordPat(lps,l) -> let (s,lps') = subst_list subst_labpat lps in
                           (s,SubRecordPat(lps',l))
  | ConstraintPat(p1,t,l) -> let (s,p1') = subst_pat p1 in
                             (s,ConstraintPat(p1',t,l))
  | AsPat(v,t,p1,l) -> let (s,p1') = subst_pat p1 in (s,AsPat(v,t,p1',l))
  | TuplePat(pl,l) -> let (s,pl') = subst_list subst_pat pl in
                      (s,TuplePat(pl',l))
  | ListPat(pl,l) -> let (s,pl') = subst_list subst_pat pl in
                     (s,ListPat(pl',l))
  | ArrayPat(pl,l) -> let (s,pl') = subst_list subst_pat pl in
                      (s,ArrayPat(pl',l))
  | OrPat(pl,l) -> let (s,pl') = subst_list subst_pat pl in
                   (s,OrPat(pl',l))
  | pat -> ([],pat)
*)

let var_wild_pat p =
  match p with
    VarPat(_,_) | WildPat(_) -> true
  | _ -> false

let rec exhaustive_rule p =
  match p with
    [] -> false
  | (p,e,_)::t -> (var_wild_pat p) or (exhaustive_rule t)
  

(* conversion functions *)

let rec convert_labty (l,t,loc) = (l, convert_ty t, loc)

and convert_ty t = 
  match t with
    VarTy (tyv,loc) -> VarTy(tyv,loc)
  | ConstTy (l,(p,("float",loc''),loc'),loc) ->
(*
   primitive "float" type must changed by "real".
   but user defined "float" type must be remained.
*)
      ConstTy(List.map convert_ty l,(p,("@float",loc''),loc'),loc)
  | ConstTy (l,lid,loc) -> ConstTy(List.map convert_ty l,lid,loc)
  | RecordTy (l,loc) -> RecordTy(List.map convert_labty l,loc)
  | TupleTy (l,loc) -> TupleTy(List.map convert_ty l,loc)
  | FunTy (t1,t2,loc) -> FunTy(convert_ty t1,convert_ty t2,loc)

let number_of_argument tyop =
  match tyop with
    None -> 0
  | Some(ty) -> begin
                  match ty with
                    TupleTy(l,_) -> List.length l
                  | _ -> 1
                end

let convert_con ((id,loc'), tyop, loc) =
  match tyop with
    None -> ((id,loc'), None, loc)
  | Some(ty) -> ((id,loc'), Some (convert_ty ty) ,loc)
   
let rec convert_labpat (l, p, loc) = (l, convert_pat p, loc)

and convert_pat p =
  match p with
    RecordPat (l,loc) -> RecordPat(List.map convert_labpat l,loc)
  | SubRecordPat (l,loc) -> SubRecordPat(List.map convert_labpat l,loc)
(*
  | RefPat (p,loc) -> convert_pat p
*)
  | AppPat (l,p,loc) -> AppPat(l, convert_pat p,loc)
  | ConstraintPat (p,t,loc) -> ConstraintPat(convert_pat p, convert_ty t,loc)
  | AsPat (id,None,p,loc) -> AsPat(id, None, convert_pat p,loc)
  | AsPat (id,Some t,p,loc) ->
              AsPat(id, Some(convert_ty t), convert_pat p,loc)
  | TuplePat (l,loc) -> TuplePat(List.map convert_pat l,loc)
  | ListPat (l,loc) -> ListPat(List.map convert_pat l,loc)
  | ArrayPat (l,loc) -> ArrayPat(List.map convert_pat l,loc)
  | OrPat(l,loc) -> OrPat(List.map convert_pat l,loc)
  | pat -> pat
       
let rec convert_labexp (l, e, loc) = (l, convert_exp e, loc)

(*
  ( p1 | p2 , p3 ) => e
  ========>
  ( p1 , p3 ) => e | ( p2 , p3 ) => e
*)
and convert_tuple_rule rl1 rl2 = begin
  let rec product' rl (p,e,l) =
        match rl with
          [] -> raise (NotConvertible ("",nloc))
        | (TuplePat(pl,lpl),e',l')::[] -> [(TuplePat(pl@[p],lpl),e,l)]
        | (p',e',l')::[] -> [(TuplePat([p';p],l),e,l)]
        | (TuplePat(pl,lpl),e',l')::t ->
            (TuplePat(pl@[p],lpl),e,l)::(product' t (p,e,l))
        | (p',e',l')::t ->
            (TuplePat([p';p],l),e,l)::(product' t (p,e,l))
  in
    List.flatten (List.map (fun x -> product' rl1 x) rl2)
  end

and convert_tuple_rule' rl1 rl2 = begin
  let rec product' rl (p,e,l) =
        match rl with
          [] -> raise (NotConvertible ("",nloc))
        | (p',e',l')::[] -> [(TuplePat([p';p],l),e,l)]
        | (p',e',l')::t ->
            (TuplePat([p';p],l),e,l)::(product' t (p,e,l))
  in
    List.flatten (List.map (fun x -> product' rl1 x) rl2)
  end

and fold_left_tuple_rule accu l c =
  match l with
    [] -> accu
  | a::l when c=0 -> fold_left_tuple_rule (convert_tuple_rule' accu a) l 1
  | a::l -> fold_left_tuple_rule (convert_tuple_rule accu a) l 1

(*
  [ p1 | p2 , p3 ] => e
  ========>
  [ p1 , p3 ] => e | [ p2 , p3 ] => e
*)
and convert_list_rule rl1 rl2 = begin
  let rec product' rl (p,e,l) =
        match rl with
          [] -> raise (NotConvertible ("",nloc))
        | (ListPat(pl,lpl),e',l')::[] -> [(ListPat(pl@[p],lpl),e,l)]
        | (p',e',l')::[] -> [(ListPat([p';p],l),e,l)]
        | (ListPat(pl,lpl),e',l')::t ->
            (ListPat(pl@[p],lpl),e,l)::(product' t (p,e,l))
        | (p',e',l')::t ->
            (ListPat([p';p],l),e,l)::(product' t (p,e,l))
  in
    List.flatten (List.map (fun x -> product' rl1 x) rl2)
  end

and convert_list_rule' rl1 rl2 = begin
  let rec product' rl (p,e,l) =
        match rl with
          [] -> raise (NotConvertible ("",nloc))
        | (p',e',l')::[] -> [(ListPat([p';p],l),e,l)]
        | (p',e',l')::t ->
            (ListPat([p';p],l),e,l)::(product' t (p,e,l))
  in
    List.flatten (List.map (fun x -> product' rl1 x) rl2)
  end

and fold_left_list_rule accu l c =
  match l with
    [] -> accu
  | a::l when c=0 -> fold_left_list_rule (convert_list_rule' accu a) l 1
  | a::l -> fold_left_list_rule (convert_list_rule accu a) l 1

(*
  [| p1 | p2 , p3 |] => e
  ========>
  [| p1 , p3 |] => e | [| p2 , p3 |] => e
*)
and convert_array_rule rl1 rl2 = begin
  let rec product' rl (p,e,l) =
        match rl with
          [] -> raise (NotConvertible ("",nloc))
        | (ArrayPat(pl,lpl),e',l')::[] -> [(ArrayPat(pl@[p],lpl),e,l)]
        | (p',e',l')::[] -> [(ArrayPat([p';p],l),e,l)]
        | (ArrayPat(pl,lpl),e',l')::t ->
            (ArrayPat(pl@[p],lpl),e,l)::(product' t (p,e,l))
        | (p',e',l')::t ->
            (ArrayPat([p';p],l),e,l)::(product' t (p,e,l))
  in
    List.flatten (List.map (fun x -> product' rl1 x) rl2)
  end

and convert_array_rule' rl1 rl2 = begin
  let rec product' rl (p,e,l) =
        match rl with
          [] -> raise (NotConvertible ("",nloc))
        | (p',e',l')::[] -> [(ArrayPat([p';p],l),e,l)]
        | (p',e',l')::t ->
            (ArrayPat([p';p],l),e,l)::(product' t (p,e,l))
  in
    List.flatten (List.map (fun x -> product' rl1 x) rl2)
  end

and fold_left_array_rule accu l c =
  match l with
    [] -> accu
  | a::l when c=0 -> fold_left_array_rule (convert_array_rule' accu a) l 1
  | a::l -> fold_left_array_rule (convert_array_rule accu a) l 1

and convert_rule (p, e, loc) =
  match p with
    OrPat(pl,l) -> List.map (fun x -> (convert_pat x, convert_exp e, l)) pl
  | AppPat(cid,p1,l) -> begin
      let rl = convert_rule (p1,e,l)
      in List.map (fun (p',e',l') -> (AppPat(cid,p',l'),e',l')) rl
      end
  | RefPat(p1,l) -> begin
      let rl = convert_rule (p1,e,l)
      in List.map (fun (p',e',l')-> (RefPat(p',l'),e',l')) rl
      end
  | ConstraintPat(p1,t,l) -> begin
      let rl = convert_rule (p1,e,l)
      in List.map (fun (p',e',l')-> (ConstraintPat(p',t,l'),e',l')) rl
      end
  | AsPat (id,None,p1,l) -> begin
      let rl = convert_rule (p1,e,l)
      in List.map (fun (p',e',l') -> (AsPat(id,None,p',l'),e',l')) rl
      end
  | AsPat (id,Some t,p1,l) -> begin
      let rl = convert_rule (p1,e,l)
      in List.map (fun (p',e',l') ->
                       (AsPat(id,Some (convert_ty t),p',l'),e',l')) rl
      end
  | TuplePat (pl,l) -> begin
      let rll = List.map (fun x -> convert_rule (x,e,l)) pl
      in fold_left_tuple_rule (List.hd rll) (List.tl rll) 0
      end
  | ListPat ([p'],l) -> begin
      let rl = convert_rule (p',e,l)
      in List.map (fun (x,e',l') -> (ListPat([x],loc),e',l')) rl
      end
  | ListPat (pl,l) -> begin
      let rll = List.map (fun x -> convert_rule (x,e,l)) pl
      in
        match rll with
          [] -> [(ListPat([],loc), convert_exp e, loc)]
        | h::t -> fold_left_list_rule h t 0
      end
  | ArrayPat ([p'],l) -> begin
      let rl = convert_rule (p',e,l)
      in List.map (fun (x,e',l') -> (ArrayPat([x],loc),e',l')) rl
      end
  | ArrayPat (pl,l) -> begin
      let rll = List.map (fun x -> convert_rule (x,e,l)) pl
      in
        match rll with
          [] -> [(ArrayPat([],loc), convert_exp e, loc)]
        | h::t -> fold_left_array_rule h t 0
      end
  | _ -> [(convert_pat p, convert_exp e, loc)]

and convert_rule_list rl =
  match rl with
    [] -> []
  | h::t -> (convert_rule h)@(convert_rule_list t)

(*
  fn p00 p01 p02 => e0
   | p10 p11 p12 => e1
   | p20 p21 p22 => e2
  ==========>
  fn x0 => x1 => x2 =>
     case (x0,x1,x2) of
       (p00,p01,p02) => e0
     | (p10,p11,p12) => e1
     | (p20,p21,p22) => e2
*)
and convert_fnrule_list (rl,loc) =
  match rl with
    [] -> raise (NotConvertible ("",nloc))
  | ([p],e,loc')::[] -> FnExp([[convert_pat p], convert_exp e, loc],loc)
  | (pl,e,loc')::[] -> begin
      let rec g l =
        match l with
          [] -> convert_exp e
        | h::t -> FnExp([[convert_pat h], (g t), loc'],loc')
      in g pl
      end
  | ([p],e,loc')::t -> begin
      let rec f l =
        match l with
          [] -> []
        | ([p],e,loc')::t -> ([convert_pat p], convert_exp e, loc')::(f t)
        | _  -> raise (NotConvertible ("",nloc))
      in FnExp(f rl,loc')
      end
  | (pl,e,loc')::t -> begin
      let rec f rl =
        match rl with
          [] -> []
        | (pl,e,loc')::t ->
            (TuplePat (List.map convert_pat pl,loc), convert_exp e, loc')::(f t)
      in
      let rec g x =
        if x = 0 then []
        else VarExp(([],("V"^(string_of_int x),loc),loc),loc)::(g (x-1))
      in
      let rec h x =
        if x = 1 then
          FnExp([([VarPat (("V"^(string_of_int x),loc),loc)],
                  CaseExp(TupleExp(g (List.length pl), loc), f rl, loc),
                  loc)],
                loc)
        else FnExp([([VarPat(("V"^(string_of_int x),loc),loc)],
                     h (x-1), loc)], loc)
      in
        h (List.length pl)
      end

and convert_tuple_to_curried exp loc =
      FnExp([([TuplePat([VarPat(("X",loc),loc); VarPat(("Y",loc),loc)],
                           loc)],
                  AppExp(AppExp(exp, VarExp(([],("X",loc),loc),loc),loc),
                         VarExp(([],("Y",loc),loc),loc),loc),loc)], loc)

and convert_exp p =
  match p with
    VarExp(([],("unary_minus",loc1),loc2),loc) ->
      VarExp(([],("~-",loc1),loc2),loc)
  | VarExp(([],("unary_minus.",loc1),loc2),loc) ->
      VarExp(([],("~-.",loc1),loc2),loc)
  | VarExp(([],(">>",loc1),loc2),loc) ->
      convert_tuple_to_curried (VarExp(([],("lsr",loc1),loc2),loc)) loc
  | VarExp(([],("<<",loc1),loc2),loc) ->
      convert_tuple_to_curried (VarExp(([],("lsl",loc1),loc2),loc)) loc
  | VarExp(([],("andalso",loc1),loc2),loc) ->
      convert_tuple_to_curried (VarExp(([],("&&",loc1),loc2),loc)) loc
  | VarExp(([],("orelse",loc1),loc2),loc) ->
      convert_tuple_to_curried (VarExp(([],("||",loc1),loc2),loc)) loc
  | VarExp(([],("div",loc1),loc2),loc) ->
      convert_tuple_to_curried (VarExp(([],("/",loc1),loc2),loc)) loc
(* 
 ++  ==>  fn x => x := (!x) + 1
*)
  | VarExp(([],("++",loc1),loc2),loc) ->
      FnExp([([VarPat (("X",loc),loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(
                                  VarExp(([],("+",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                IntExp(1,loc),loc),loc),loc)],loc)
(* 
 --  ==>  fn x => x := (!x) - 1
*)
  | VarExp(([],("--",loc1),loc2),loc) ->
      FnExp([([VarPat (("X",loc),loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(
                                  VarExp(([],("-",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                IntExp(1,loc),loc),loc),loc)],loc)
(*
 +=  ==>  fn (x,y) => x := (!x) + y
*)
  | VarExp(([],("+=",loc1),loc2),loc) ->
      FnExp([([TuplePat([VarPat(("X",loc),loc);
                            VarPat(("Y",loc),loc)],loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(VarExp(([],("+",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                VarExp(([],("Y",loc1),loc),loc),loc),loc),loc)],loc)
(*
 -=  ==>  fn (x,y) => x := (!x) - y
*)
  | VarExp(([],("-=",loc1),loc2),loc) ->
      FnExp([([TuplePat([VarPat(("X",loc),loc);
                            VarPat(("Y",loc),loc)],loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(VarExp(([],("-",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                VarExp(([],("Y",loc1),loc),loc),loc),loc),loc)],loc)
(*
 *=  ==>  fn (x,y) => x := (!x) * y
*)
  | VarExp(([],("*=",loc1),loc2),loc) ->
      FnExp([([TuplePat([VarPat(("X",loc),loc);
                            VarPat(("Y",loc),loc)],loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(VarExp(([],("*",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                VarExp(([],("Y",loc1),loc),loc),loc),loc),loc)],loc)
(*
 /=  ==>  fn (x,y) => x := (!x) / y
*)
  | VarExp(([],("/=",loc1),loc2),loc) ->
      FnExp([([TuplePat([VarPat(("X",loc),loc);
                            VarPat(("Y",loc),loc)],loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(VarExp(([],("/",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                VarExp(([],("Y",loc1),loc),loc),loc),loc),loc)],loc)
(*
 ++. --. +=. -=. *=. /=.
 for real operation
*)
  | VarExp(([],("++.",loc1),loc2),loc) ->
      FnExp([([VarPat (("X",loc),loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(
                                  VarExp(([],("+.",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                RealExp("1.0",loc),loc),loc),loc)],loc)
  | VarExp(([],("--.",loc1),loc2),loc) ->
      FnExp([([VarPat (("X",loc),loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(
                                  VarExp(([],("-.",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                RealExp("1.0",loc),loc),loc),loc)],loc)
  | VarExp(([],("+=.",loc1),loc2),loc) ->
      FnExp([([TuplePat([VarPat(("X",loc),loc);
                            VarPat(("Y",loc),loc)],loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(VarExp(([],("+.",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                VarExp(([],("Y",loc1),loc),loc),loc),loc),loc)],loc)
  | VarExp(([],("-=.",loc1),loc2),loc) ->
      FnExp([([TuplePat([VarPat(("X",loc),loc);
                            VarPat(("Y",loc),loc)],loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(VarExp(([],("-.",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                VarExp(([],("Y",loc1),loc),loc),loc),loc),loc)],loc)
  | VarExp(([],("*=.",loc1),loc2),loc) ->
      FnExp([([TuplePat([VarPat(("X",loc),loc);
                            VarPat(("Y",loc),loc)],loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(VarExp(([],("*.",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                VarExp(([],("Y",loc1),loc),loc),loc),loc),loc)],loc)
  | VarExp(([],("/=.",loc1),loc2),loc) ->
      FnExp([([TuplePat([VarPat(("X",loc),loc);
                            VarPat(("Y",loc),loc)],loc)],
                  AppExp(AppExp(VarExp(([],(":=",loc1),loc),loc),
                                VarExp(([],("X",loc1),loc),loc),loc),
                         AppExp(AppExp(VarExp(([],("/.",loc1),loc),loc),
                                  DeRefExp(VarExp(([],("X",loc1),loc),loc),loc),loc),
                                VarExp(([],("Y",loc1),loc),loc),loc),loc),loc)],loc)
(*
 ::  =>  fn (x,y) => x::y
 ocaml :: is con
 nML :: is var
*)
  | VarExp(([],("::",loc1),loc2),loc) ->
      FnExp([([TuplePat([VarPat(("X",loc),loc);
                            VarPat(("Y",loc),loc)],loc)],
                  AppExp(ConExp(([],("::",loc1),loc),loc),
                         TupleExp([VarExp(([],("X",loc),loc),loc);
                                   VarExp(([],("Y",loc),loc),loc)],loc),loc),
                  loc)],loc)
(*
 ocaml operator : curried function
 nML operator : arguments are tuple
*)
  | VarExp((sl,(id,loc1),loc2),loc) as e -> begin
      let alpha_oplist = ["mod";"land";"lor";"lxor";"lsl";"lsr"] in
      let infix_oplist = ["+";"-";"*";"/";"&&";"||";"=";"<";">";":=";"<>";
                          "<=";">=";"^";"@";"**"]
      in
        try (fun x -> ()) (List.find (fun x -> x = id) alpha_oplist);
            convert_tuple_to_curried e loc
        with Not_found ->
          begin
            try (fun x -> ()) (List.find (fun x -> x = id) infix_oplist);
                convert_tuple_to_curried e loc
            with Not_found -> e
          end
      end
(*
  nML :: is var
  ocaml :: is con
*)
  | AppExp (VarExp(([],("::",loc3),loc4),loc1), TupleExp([e1;e2],loc2),loc) ->
      AppExp (ConExp(([],("::",loc3),loc4),loc1),
              TupleExp([convert_exp e1;convert_exp e2],loc2),loc)
(*
  nML ** : overloaded (int, real)
  ocaml ** : float * float -> float
*)
  | AppExp (VarExp(([],("**",loc3),loc4),loc1), TupleExp([e1;e2],loc2),loc) ->
      begin
      let e1' = if is_real e1 then e1
                else AppExp(VarExp(([],("float_of_int",loc2),loc2),loc2),
                            convert_exp e1,loc2) in
      let e2' = if is_real e2 then e2
                else AppExp(VarExp(([],("float_of_int",loc2),loc2),loc2),
                            convert_exp e2,loc2) in
      let e' = AppExp(AppExp(VarExp(([],("**",loc3),loc4),loc1),
                      e1',loc),e2',loc)
      in
          if is_real e1 || is_real e2 then e'
          else AppExp(VarExp(([],("int_of_float",loc),loc),loc), e',loc)
      end
(*
 "e1 op e2"
 if "e1" or "e2" is explicitly real, "e1 op. e2".
 else "e1 op e2".
*)
   | AppExp (VarExp(([],("andalso",loc3),loc4),loc1), TupleExp([e1;e2],loc2),loc) ->
     let e1' = AppExp(VarExp(([],("not",loc1),loc1),loc1), convert_exp e1, loc)
     in
     let e2' = ConExp(([],("false",loc1),loc1),loc1) in
     let e3' = convert_exp e2 in
       IfExp (e1',e2',e3',loc)
   | AppExp (VarExp(([],("orelse",loc3),loc4),loc1), TupleExp([e1;e2],loc2),loc) ->
     let e1' = convert_exp e1 in
     let e2' = ConExp(([],("true",loc1),loc1),loc1) in
     let e3' = convert_exp e2 in
       IfExp (e1',e2',e3',loc)
   | AppExp (VarExp(([],(op,loc3),loc4),loc1), TupleExp([e1;e2],loc2),loc) ->
      begin
        let oplist1 = ["+";"-";"*";"/"] in
        let oplist2 = ["+=";"-=";"*=";"/="] in
        let oplist3 = ["mod";"land";"lor";"lxor";"lsl";"lsr";"&&";"||";
                       "=";"<";">";":=";"<>";"<=";">=";"^";"@"]
        in
          try (fun x -> ()) (List.find (fun x -> x = op) oplist1);
          begin
            if is_real e1 || is_real e2 then
              AppExp(AppExp(VarExp(([],(op^".",loc3),loc4),loc1),
                            convert_exp e1,loc), convert_exp e2,loc)
            else
              AppExp(AppExp(VarExp(([],(op,loc3),loc4),loc1),
                            convert_exp e1,loc), convert_exp e2,loc)
          end
        with Not_found ->
          begin
          try (fun x -> ()) (List.find (fun x -> x = op) oplist2);
            begin
              if is_real_ref e1 || is_real e2 then
                AppExp(convert_exp (VarExp(([],(op^".",loc3),loc4),loc1)),
                       TupleExp([convert_exp e1; convert_exp e2],loc2),loc)
              else
                AppExp(convert_exp (VarExp(([],(op,loc3),loc4),loc1)),
                       TupleExp([convert_exp e1; convert_exp e2],loc2),loc)
            end
          with Not_found ->
            begin
            try (fun x -> ()) (List.find (fun x -> x = op) oplist3);
              AppExp(AppExp(VarExp(([],(op,loc3),loc4),loc1),
                            convert_exp e1,loc), convert_exp e2,loc)
            with Not_found ->
              let op' = match op with
                          "unary_minus" -> "~-"
                        | "unary_minus." -> "~-."
                        | ">>" -> "lsr"
                        | "<<" -> "lsl"
                        | "andalso" -> "&&"
                        | "orelse" -> "||"
                        | "div" -> "/"
                        | "%" -> "mod"
                        | p -> p
              in
                if op' = op then
                  AppExp(VarExp(([],(op',loc3),loc4),loc1),
                         TupleExp([convert_exp e1; convert_exp e2],loc2),loc)
                else
                  AppExp(AppExp(VarExp(([],(op',loc3),loc4),loc1),
                         convert_exp e1,loc),convert_exp e2,loc)
            end
          end
      end
  | AppExp (VarExp(([],(op,loc3),loc4),loc1), e, loc) ->
      begin
        let oplist = ["++";"--"]
        in
          if op = "unary_minus" then
            begin
              if is_real e then
                AppExp(convert_exp (VarExp(([],(op^".",loc3),loc4),loc1)),
                       convert_exp e,loc)
              else
                AppExp(convert_exp (VarExp(([],(op,loc3),loc4),loc1)),
                       convert_exp e,loc)
            end
          else
            try (fun x -> ()) (List.find (fun x -> x = op) oplist);
              begin
                if is_real_ref e then
                  AppExp(convert_exp (VarExp(([],(op^".",loc3),loc4),loc1)),
                         convert_exp e,loc)
                else
                  AppExp(convert_exp (VarExp(([],(op,loc3),loc4),loc1)),
                         convert_exp e,loc)
              end
            with Not_found ->
              AppExp(VarExp(([],(op,loc3),loc4),loc1),convert_exp e,loc)
      end
(*
  | AppExp (ConExp (([],(cid,locc'),locc), loc1), e2, loc) -> begin
      let num_arg = Hashtbl.find con_table cid in
      let rec make_tpat num =
        if num = num_arg then []
        else (VarPat(("X"^(string_of_int num),loc1),loc1))::(make_tpat (num+1))
      in
      let rec make_texp num =
        if num = num_arg then []
        else (VarExp(([],("X"^(string_of_int num),loc1),loc1),loc1))
             ::(make_texp (num+1))
      in
        LetExp (ValDec ([],
                        [ValBind (TuplePat(make_tpat 0,loc1),
                                  convert_exp e2,
                                  loc1)],
                        loc1),
                AppExp (ConExp (([],(cid,locc'),locc), loc1),
                        TupleExp (make_texp 0,loc), loc), loc)
      end
*)
  | AppExp (e, e',loc) -> AppExp(convert_exp e, convert_exp e',loc)
  | RecordExp (l,loc) -> RecordExp(List.map convert_labexp l,loc)
  | RecordFieldExp (e, l,loc) -> RecordFieldExp(convert_exp e, l,loc)
  | ArrayFieldExp (e, e',loc) ->
       ArrayFieldExp(convert_exp e, convert_exp e',loc)
  | UpdateArrayExp (e, e', e'',loc) ->
       UpdateArrayExp(convert_exp e, convert_exp e', convert_exp e'',loc)
  | SubstRecordExp (e, (lab,loc1), e',loc) ->
       SubstRecordExp (convert_exp e, (lab,loc1), convert_exp e', loc)
  | TupleExp (l,loc) -> TupleExp(List.map convert_exp l,loc)
  | ListExp (l,loc) -> ListExp(List.map convert_exp l,loc)
  | ArrayExp (l,loc) -> ArrayExp(List.map convert_exp l,loc)
  | LetExp (SeqDec(dl,loc1),e,loc) -> convert_letexp dl e loc
  | LetExp (_,_,loc) -> raise (NotConvertible ("",nloc))
  | HandleExp (e,l,loc) ->
      HandleExp(convert_exp e, convert_rule_list l,loc)
  | RaiseExp (e,loc) -> RaiseExp(convert_exp e,loc)
  | FnExp (l,loc) -> convert_fnrule_list (l,loc)
  | AssignExp (e, e',loc) -> AssignExp(convert_exp e, convert_exp e',loc)
  | RefExp (e,loc) -> RefExp(convert_exp e,loc)
  | DeRefExp (e,loc) -> DeRefExp(convert_exp e,loc)
  | SeqExp (l,loc) -> SeqExp(List.map convert_exp l,loc)
  | CaseExp (e, l,loc) -> CaseExp(convert_exp e, convert_rule_list l,loc)
  | IfExp (e, e', e'',loc) ->
      IfExp(convert_exp e, convert_exp e', convert_exp e'',loc)
  | WhileExp (e, e',loc) -> WhileExp(convert_exp e, convert_exp e',loc)
  | ForExp (id, e, e', e'', e''',loc) ->
      LetExp(
        RecValDec(
          [],
          [(VarPat(("f",loc),loc),
		    FnExp([([VarPat(id,loc)],
				IfExp(convert_exp e',
				      SeqExp([convert_exp e''';
					      AppExp(VarExp(([],("f",loc),loc),loc),
						     convert_exp e'',loc)
					      ],loc),
				       UnitExp loc
				      ,loc)
			       ,loc)],loc)
		    ,loc)]
		  ,loc),
		AppExp(VarExp(([],("f",loc),loc),loc), convert_exp e, loc)
		,loc)
	  | ConstraintExp (e,t,loc) -> ConstraintExp(convert_exp e, convert_ty t, loc)
	  | exp -> exp

	and convert_letexp dl e loc =
	  match dl with
	    [] -> raise (NotConvertible ("",loc))
	  | h::[] -> LetExp(convert_letdec h, convert_exp e,loc)
	  | h::t -> LetExp(convert_letdec h, convert_letexp t e loc, loc)

	and convert_letdec p =
	  match p with
	    ValDec (tyvs,l,loc) ->
	      let prev_tyvs = !valbind_tyvarseq in
	      let _ = valbind_tyvarseq := tyvs @ prev_tyvs
	      and result = ValDec(tyvs, List.map convert_valbind l,loc)
	      and _ = valbind_tyvarseq := prev_tyvs
	      in result
	  | RecValDec (tyvs,l,loc) ->
	      let prev_tyvs = !valbind_tyvarseq in
	      let _ = valbind_tyvarseq := tyvs @ prev_tyvs
	      and result = RecValDec(tyvs, List.map convert_valbind l,loc)
	      and _ = valbind_tyvarseq := prev_tyvs
	      in result
	  | FunDec (tyvs, l,loc) ->
	      let prev_tyvs = !valbind_tyvarseq in
	      let _ = valbind_tyvarseq := tyvs @ prev_tyvs
	      and result = FunDec(tyvs, List.map convert_funbind l,loc)
	      and _ = valbind_tyvarseq := prev_tyvs
	      in result
	  | TypeDec (_, loc) ->
		 raise (NotConvertible
			  ("only value declarations are possible in let in end ",loc))
	  | AbstypeDec (_, _, loc) ->
		 raise (NotConvertible
			  ("only value declarations are possible in let in end ",loc))
	  | ExceptionDec (_, loc) ->
		 raise (NotConvertible
			  ("only value declarations are possible in let in end ",loc))
	  | LocalDec (_, _, loc) ->
		 raise (NotConvertible
			  ("only value declarations are possible in let in end ",loc))
	  | OpenDec (_, loc) ->
		 raise (NotConvertible
			  ("only value declarations are possible in let in end ",loc))
	  | SeqDec (_, loc) ->
		 raise (NotConvertible
			  ("only value declarations are possible in let in end ",loc))

	and convert_valbind (p,e,loc) =
	      (convert_pat p,convert_exp e,loc)

	and convert_funbind (l,loc) =
	  begin
	    let convert_temp (id,pl,e,loc) =
		  (id, List.map convert_pat pl, convert_exp e, loc)
	    in 
	      (List.map convert_temp l,loc)
	  end

	and convert_typebind p =
	  match p with
	    TypeBind (tyvs, ("float",loc2), RecordTy (l,loc1), loc) -> begin
	      let convert_labty ((lab,loc3),t,loc) = ((lab,loc3), convert_ty t, loc) in
		TypeBind(tyvs, ("@float",loc2),
			 RecordTy (List.map convert_labty l,loc1), loc)
	      end
	  | TypeBind (tyvs, ("float",loc2), ty, loc) ->
	      TypeBind(tyvs, ("@float",loc2), convert_ty ty, loc)
	  | TypeBind (tyvs, (id,loc2), RecordTy (l,loc1), loc) -> begin
	      let convert_labty ((lab,loc3),t,loc) = ((lab,loc3), convert_ty t, loc) in
		TypeBind(tyvs, (id,loc2), RecordTy (List.map convert_labty l,loc1), loc)
	      end
	  | TypeBind (tyvs, id, ty, loc) -> TypeBind(tyvs, id, convert_ty ty, loc)
	  | DataBind (tyvs, ("float",loc2), cl, loc) ->
	      DataBind(tyvs, ("@float",loc2), (List.map convert_con cl), loc)
	  | DataBind (tyvs, id, cl, loc) ->
	      DataBind(tyvs, id, (List.map convert_con cl), loc)

	and convert_exnbind (c) = (convert_con c)

	and convert_dec p = begin
	  match p with
	    ValDec (tyvs, l, loc) -> begin
	      let prev_tyvs = !valbind_tyvarseq
	      in let _ = valbind_tyvarseq := tyvs @ prev_tyvs
		 and result = ValDec(tyvs, List.map convert_valbind l, loc)
		 and _ = valbind_tyvarseq := prev_tyvs
		 in result
	      end
	  | RecValDec (tyvs, l, loc) -> begin
	      let prev_tyvs = !valbind_tyvarseq
	      in  let _ = valbind_tyvarseq := tyvs @ prev_tyvs
		  and result = RecValDec(tyvs, List.map convert_valbind l, loc)
		  and _ = valbind_tyvarseq := prev_tyvs
		  in result
	      end
	  | FunDec (tyvs, l, loc) -> begin
	      let prev_tyvs = !valbind_tyvarseq
	      in  let _ = valbind_tyvarseq := tyvs @ prev_tyvs
		  and result = FunDec(tyvs, List.map convert_funbind l, loc)
		  and _ = valbind_tyvarseq := prev_tyvs
		  in result
	      end
	  | TypeDec (l, loc) -> TypeDec(List.map convert_typebind l, loc)
	  | AbstypeDec (l, d, loc) ->
	      AbstypeDec(List.map convert_typebind l, convert_dec d, loc)
	  | ExceptionDec (l, loc) -> ExceptionDec (List.map convert_exnbind l, loc)
	  | LocalDec (d, d', loc) -> LocalDec(convert_dec d, convert_dec d', loc)
	  | OpenDec (l, loc) -> OpenDec(l, loc)
	  | SeqDec (l, loc) -> SeqDec(List.map convert_dec l, loc)
	  end

	let convert_longtypebind (tyvs, l, ty, loc) =
	      (tyvs, l, convert_ty ty, loc)

	let convert_where (l, loc) = (List.map convert_longtypebind l, loc)

	let convert_valdesc (id, t, loc) = (id, convert_ty t, loc)

	let convert_typedesc p =
	  match p with
	    TypeDesc (l,("float",loc2),loc) -> TypeDesc(l,("@float",loc2),loc)
	  | TypeDesc (l,tyid,loc) -> TypeDesc(l,tyid,loc)
	  | TypeBindDesc (tyvs, ("float",loc2), RecordTy (l,loc1), loc) -> begin
	      let convert_labty ((lab,loc3),t,loc) = ((lab,loc3), convert_ty t, loc) in
		TypeBindDesc(tyvs, ("@float",loc2),
			     RecordTy (List.map convert_labty l,loc1), loc)
	      end
	  | TypeBindDesc (tyvs, ("float",loc2), ty, loc) ->
	      TypeBindDesc(tyvs, ("@float",loc2), convert_ty ty, loc)
	  | TypeBindDesc (tyvs, (id,loc2), RecordTy (l,loc1), loc) -> begin
	      let convert_labty ((lab,loc3),t,loc) = ((lab,loc3), convert_ty t, loc) in
		TypeBindDesc(tyvs, (id,loc2),
			     RecordTy (List.map convert_labty l,loc1), loc)
	      end
	  | TypeBindDesc (tyvs, id, ty, loc) ->
	      TypeBindDesc(tyvs, id, convert_ty ty, loc)
	  | DataDesc (tyvs, id, cl, loc) ->
	      DataDesc(tyvs, id, (List.map convert_con cl), loc)

	let convert_exndesc (c) = (convert_con c)

	let rec convert_strdesc (id, se,loc) = (id, convert_sigexp se,loc)

	and convert_spec p =
	  match p with
	    ValSpec (l,loc) -> ValSpec(List.map convert_valdesc l,loc)
	  | TypeSpec (l,loc) -> TypeSpec(List.map convert_typedesc l,loc)
	  | ExnSpec (l,loc) -> ExnSpec(List.map convert_exndesc l,loc)
	  | IncludeSpec (s,loc) -> IncludeSpec(convert_sigexp s,loc)
	  | StrSpec (l,loc) -> StrSpec(List.map convert_strdesc l,loc)
	  | SeqSpec (l,loc) -> SeqSpec(List.map convert_spec l,loc)

	and convert_sigexp p =
	  match p with
	    VarSig (l,loc) -> VarSig(l,loc)
	  | SigSig (s,loc) -> SigSig(convert_spec s,loc)
	  | ConstraintSig (se, wh,loc) ->
	      ConstraintSig(convert_sigexp se, convert_where wh,loc)

	let convert_sigexpop p =
	  match p with
	    None -> None
	  | Some(s) -> Some(convert_sigexp s)

	let convert_sigbind (id, s,loc) = (id , convert_sigexp s,loc)

	let convert_sigdec (l,loc) = (List.map convert_sigbind l,loc)

	let rec convert_strexp p = 
	  match p with
	    VarStr (l,loc) -> VarStr(l,loc)
	  | StrStr (d,loc) -> StrStr(convert_strdec d,loc)
	  | SigStr (ste, sie,loc) -> SigStr(convert_strexp ste, convert_sigexp sie,loc)
	  | FctAppStr (id, sl,loc) -> FctAppStr(id, List.map convert_strexp sl,loc)

	and convert_strbind (id, sgop, se,loc) =
              (id, convert_sigexpop sgop, convert_strexp se,loc)

	and convert_strdec p = 
	  match p with
	    SimpleDec (d,loc) -> SimpleDec(convert_dec d,loc)
	  | StrDec (l,loc) -> StrDec(List.map convert_strbind l,loc)
	  | SeqStrDec (l,loc) -> SeqStrDec(List.map convert_strdec l,loc)

	let convert_sigop (sgop, se, loc) =
	  match sgop with
	    None -> se
	  | Some(sg) -> SigStr(se, sg, loc)

        let rec split3 l =
          match l with
            [] -> ([],[],[])
          | (a,b,c)::t -> begin let (al,bl,cl) = split3 t
                                in (a::al,b::bl,c::cl)
                          end

        let rec combine3 al bl cl =
          match (al,bl,cl) with
            ([],[],[]) -> []
          | (ah::at,bh::bt,ch::ct) -> (ah,bh,ch)::(combine3 at bt ct)
          | _ -> raise CombineError

        let convert_fctdec (id, al, sgop, se, loc) = begin
          let (aidl,asel,alocl) = split3 al in
            (id, combine3 aidl (List.map convert_sigexp asel) alocl,
             None, convert_sigop (sgop, convert_strexp se, loc), loc)
          end

	let rec convert_topdec p =
	  match p with
	    Sig (d,loc) -> Sig(convert_sigdec d,loc)
	  | Fct (d,loc) -> Fct(convert_fctdec d,loc)
	  | Str (d,loc) -> Str(convert_strdec d,loc)
	  | SeqTopDec (dl,loc) -> SeqTopDec(List.map convert_topdec dl,loc)

	let convert_toplevel p =
	  match p with
	    TopDef (d) -> TopDef (convert_topdec d)
	  | TopExp (el,loc) -> TopExp (List.map convert_exp el,loc)
	  | topdir -> topdir