From 5fb518d8eda904b7e02626af0f57a4d1d28261f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9onard=20G=C3=A9rard?= Date: Tue, 29 Mar 2011 20:43:55 +0200 Subject: [PATCH] Java bugfix --- compiler/obc/java/java_main.ml | 7 +++++++ compiler/obc/java/java_printer.ml | 27 +++++++++++++++++---------- compiler/obc/java/obc2java.ml | 4 ++-- 3 files changed, 26 insertions(+), 12 deletions(-) diff --git a/compiler/obc/java/java_main.ml b/compiler/obc/java/java_main.ml index db160fd..d321f5a 100644 --- a/compiler/obc/java/java_main.ml +++ b/compiler/obc/java/java_main.ml @@ -1,4 +1,5 @@ open Misc +open Names open Signature open Java open Java_printer @@ -45,10 +46,16 @@ let program p = let args1 = Eval(Parray_elem(pat_args, Sint 1)) in let out = Eval(Pclass(Names.qualname_of_string "java.lang.System.out")) in let jarrays = Eval(Pclass(Names.qualname_of_string "java.util.Arrays")) in + let jint = Eval(Pclass(Names.qualname_of_string "Integer")) in + let jfloat = Eval(Pclass(Names.qualname_of_string "Float")) in + let jbool = Eval(Pclass(Names.qualname_of_string "Boolean")) in let ret = Emethod_call(e_main, "step", []) in let print_ret = match ty_main with | Types.Tarray (Types.Tarray _, _) -> Emethod_call(jarrays, "deepToString", [ret]) | Types.Tarray _ -> Emethod_call(jarrays, "toString", [ret]) + | t when t = Initial.tint -> Emethod_call(jint, "toString", [ret]) + | t when t = Initial.tfloat -> Emethod_call(jfloat, "toString", [ret]) + | t when t = Initial.tbool -> Emethod_call(jbool, "toString", [ret]) | _ -> Emethod_call(ret, "toString", []) in [ Anewvar(vd_main, Enew (Tclass q_main, [])); diff --git a/compiler/obc/java/java_printer.ml b/compiler/obc/java/java_printer.ml index d575be6..db3e290 100644 --- a/compiler/obc/java/java_printer.ml +++ b/compiler/obc/java/java_printer.ml @@ -35,16 +35,19 @@ let static ff s = if s then fprintf ff "static " else () let final ff f = if f then fprintf ff "final " else () -let rec _ty size ff t = match t with +let rec _ty news ff t = match t with | Tbool -> fprintf ff "boolean" | Tint -> fprintf ff "int" | Tfloat -> fprintf ff "float" | Tclass n -> class_name ff n - | Tgeneric (n, ty_l) -> fprintf ff "%a<@[%a@]>" class_name n (print_list_r ty """,""") ty_l - | Tarray (t,s) -> if size then fprintf ff "%a[%a]" full_ty t exp s else fprintf ff "%a[]" ty t + | Tgeneric (n, ty_l) -> + if news + then fprintf ff "%a" class_name n + else fprintf ff "%a<@[%a@]>" class_name n (print_list_r ty """,""") ty_l + | Tarray (t,s) -> if news then fprintf ff "%a[%a]" new_ty t exp s else fprintf ff "%a[]" ty t | Tunit -> pp_print_string ff "void" -and full_ty ff t = _ty true ff t +and new_ty ff t = _ty true ff t and ty ff t = _ty false ff t @@ -72,10 +75,10 @@ and exp ff = function | Eval p -> pattern ff p | Efun (f,e_l) -> op ff (f, e_l) | Emethod_call (o,m,e_l) -> fprintf ff "%a.%a%a" exp o method_name m args e_l - | Enew (c,e_l) -> fprintf ff "new %a%a" full_ty c args e_l + | Enew (c,e_l) -> fprintf ff "new %a%a" new_ty c args e_l | Enew_array (t,e_l) -> (match e_l with - | [] -> fprintf ff "new %a" full_ty t + | [] -> fprintf ff "new %a" new_ty t | _ -> fprintf ff "new %a@[<2>%a@]" ty t (print_list_r exp "{"",""}") e_l ) | Evoid -> () | Ecast (t,e) -> fprintf ff "(%a)(%a)" ty t exp e @@ -114,7 +117,8 @@ and op ff (f, e_l) = | "~-" -> let e = Misc.assert_1 e_l in fprintf ff "-%a" exp e - | s -> fprintf ff "jeptagon.Pervasives.%s%a" s args e_l) (* TODO java deal with this correctly + | s -> fprintf ff "jeptagon.Pervasives.%s%a" s args e_l) + (* TODO java deal with this correctly bug when using Pervasives.ggg in the code but works when using ggg directly *) | _ -> fprintf ff "%a%a" Global_printer.print_qualname f args e_l @@ -134,7 +138,8 @@ let rec block ff b = (* and switch_hack ff c_b_l = - fprintf ff "@[ default :\\Dead code. Hack to prevent \"may not be initialized\" java error.@ %a@ break;@]" + fprintf ff "@[ default : + \\Dead code. Hack to prevent \"may not be initialized\" java error.@ %a@ break;@]" block (c_b_l |> List.hd |> snd) *) @@ -143,10 +148,12 @@ and act ff = function | Aassgn (p,e) -> fprintf ff "@[<4>%a =@ %a;@]" pattern p exp e | Amethod_call (o,m,e_l) -> fprintf ff "@[%a.%a%a;@]" exp o method_name m args e_l | Aswitch (e, c_b_l) -> - let pcb ff (c,b) = fprintf ff "@[case %a:@ %a@ break;@]" bare_constructor_name c block b in + let pcb ff (c,b) = + fprintf ff "@[case %a:@ %a@ break;@]" bare_constructor_name c block b in (* let switch_hack ff c_b_l = (* TODO java : better thing to do ? *) fprintf ff "@[<2>default ://Dead code. Hack to prevent \ - \"may not be initialized\" java error.@ %a@ break;@]" block (c_b_l |> List.hd |> snd) + \"may not be initialized\" + java error.@ %a@ break;@]" block (c_b_l |> List.hd |> snd) in*) fprintf ff "@[switch (%a) {@ %a@]@\n}" exp e diff --git a/compiler/obc/java/obc2java.ml b/compiler/obc/java/obc2java.ml index 163ef15..8fbc5ed 100644 --- a/compiler/obc/java/obc2java.ml +++ b/compiler/obc/java/obc2java.ml @@ -47,7 +47,7 @@ let rec translate_modul m = m (*match m with | Pervasives | LocalModule -> m | _ when m = g_env.current_mod -> m - | Module n -> Module (String.lowercase n) + | Module n -> Module n | QualModule { qual = q; name = n} -> QualModule { qual = translate_modul q; name = String.lowercase n } *) @@ -126,7 +126,7 @@ and boxed_ty param_env t = match t with | Types.Tid t when t = Initial.pint -> Tclass (Names.local_qn "Integer") | Types.Tid t when t = Initial.pfloat -> Tclass (Names.local_qn "Float") | Types.Tid t -> Tclass (qualname_to_class_name t) - | Types.Tarray (t,size) -> Tarray (boxed_ty param_env t, static_exp param_env size) + | Types.Tarray (t,size) -> Tarray (ty param_env t, static_exp param_env size) | Types.Tinvalid -> Misc.internal_error "obc2java invalid type" 1 and tuple_ty param_env ty_l =