From 3609c824b6b0b085cab0a1d839c08b362343abf3 Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Sun, 5 Jan 2014 22:19:05 +0100 Subject: Update makefile --- src/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile b/src/Makefile index 51b57aa..619fac9 100644 --- a/src/Makefile +++ b/src/Makefile @@ -2,7 +2,7 @@ BIN=minic++ all: $(BIN) -$(BIN): main.ml ast.ml parser.mly lexer.mll pretty.ml typing.ml pretty_typing.ml +$(BIN): main.ml ast.ml parser.mly lexer.mll pretty.ml typing.ml pretty_typing.ml codegen.ml ocamlbuild main.native mv main.native $(BIN) -- cgit v1.2.3 From 62b36681f7a700018de11d74067a10a013597dd8 Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Mon, 6 Jan 2014 18:17:38 +0100 Subject: Use { x with ... }, excellent ! --- src/typing.ml | 78 ++++++++++++++++++++++------------------------------------- 1 file changed, 29 insertions(+), 49 deletions(-) diff --git a/src/typing.ml b/src/typing.ml index 009c8b5..c5a44e3 100644 --- a/src/typing.ml +++ b/src/typing.ml @@ -110,12 +110,6 @@ and tcls = { tc_methods : tproto list; } -let tproto_numbering = ref 1 -let tproto_unique_number () = - let k = !tproto_numbering in - tproto_numbering := k + 1; - string_of_int k - type env = { e_globals : typ Smap.t; e_funs : tproto list; @@ -140,6 +134,12 @@ type tprogram = { (* Quelques fonctions utiles : *) +let tproto_numbering = ref 1 +let tproto_unique_number () = + let k = !tproto_numbering in + tproto_numbering := k + 1; + string_of_int k + let get_c env i = try Smap.find i env.e_classes with Not_found -> ty_error ("No such class: " ^ i) @@ -316,21 +316,21 @@ and compute_type env e = (TEAssign (te1,te2) ),(ty1,false,false) | EUnary (op,e) -> let te,(ty,b1,b2) = get_expr0 env e in (match op with - | PreIncr | PostIncr | PreDecr | PostDecr -> - ty_assert (b2 = true) "Can only increment/decrement lvalue"; - ty_assert (ty = T_Int) "Can only increment/decrement integers"; - TEUnary(op,te),(T_Int,b1,false) - | Plus | Minus | Not -> - ty_assert (ty = T_Int) "Can only apply unary plus/minus/not to integers"; - TEUnary(op,te),(T_Int,false,false) - | Ref -> - ty_assert b2 "Can only reference lvalues"; - TEUnary(op,te),(TPoint ty,false,false) (* verif *) - | Deref -> - let t = (match ty with - | TPoint t -> t - | _ -> ty_error "Can only dereference pointer" ) in - TEUnary(op,te), (t,false,true) + | PreIncr | PostIncr | PreDecr | PostDecr -> + ty_assert (b2 = true) "Can only increment/decrement lvalue"; + ty_assert (ty = T_Int) "Can only increment/decrement integers"; + TEUnary(op,te),(T_Int,b1,false) + | Plus | Minus | Not -> + ty_assert (ty = T_Int) "Can only apply unary plus/minus/not to integers"; + TEUnary(op,te),(T_Int,false,false) + | Ref -> + ty_assert b2 "Can only reference lvalues"; + TEUnary(op,te),(TPoint ty,false,false) (* verif *) + | Deref -> + let t = (match ty with + | TPoint t -> t + | _ -> ty_error "Can only dereference pointer" ) in + TEUnary(op,te), (t,false,true) ) | EBinary (e1,op,e2) -> let te1,(ty1,_,b1) = get_expr0 env e1 in let te2,(ty2,_,b2) = get_expr0 env e2 in @@ -470,10 +470,7 @@ and compute_type_stm ret_type env s = match s.s_desc with (* statement -> ts_des | SDeclare(vt,i) -> let ty,b = build_type_or_ref vt in ty_assert (bf env.b_pe ty) "Malformed type"; ty_assert (not (Smap.mem i env.b_locals) ) "Variable redefinition"; - let env0 = - { b_pe = env.b_pe; - b_locals = Smap.add i (ty,b) env.b_locals; - b_class = env.b_class } in + let env0 = { env with b_locals = Smap.add i (ty,b) env.b_locals } in TSDeclare( (ty,b) ,i) , env0 | SDeclareAssignExpr(vt,i,e) -> let ty,b = build_type_or_ref vt in ty_assert (bf env.b_pe ty) "Malformed type"; @@ -481,10 +478,7 @@ and compute_type_stm ret_type env s = match s.s_desc with (* statement -> ts_des let te,(tye,r,l) = get_expr0 env e in ty_assert (if b then r || l else true) "Can only assigne lvalue/reference to reference type var"; ty_assert (subtype env.b_pe tye ty) "Invalid data type for assign."; - let env0 = - { b_pe = env.b_pe; - b_locals = Smap.add i (ty,b) env.b_locals; - b_class = env.b_class } in + let env0 = { env with b_locals = Smap.add i (ty,b) env.b_locals } in TSDeclareAssignExpr( (ty,b) ,i,te) , env0 | SDeclareAssignConstructor(vt,i,ti,e_l) -> let ty, b = build_type_or_ref vt in @@ -504,10 +498,7 @@ and compute_type_stm ret_type env s = match s.s_desc with (* statement -> ts_des let p = closest_proto env.b_pe args_types candidates in (* closest_proto makes sure the prototypes match, no problem here *) let l_te = List.map fst args_values in - let env0 = - { b_pe = env.b_pe; - b_locals = Smap.add i (ty,b) env.b_locals; - b_class = env.b_class } in + let env0 = { env with b_locals = Smap.add i (ty,b) env.b_locals } in TSDeclareAssignConstructor(ty, i, Some p, ti, l_te), env0 end | SWriteCout(str_e_list) -> @@ -574,10 +565,7 @@ let get_fun env p b = (* p : proto b : block -> tp, tb, env2*) tp_virtual = None ; tp_ret_type = Some ret_type ; tp_args = ty_args; } in - let env2 = - { e_globals = env.e_globals; - e_funs = tproto::(env.e_funs); - e_classes = env.e_classes; } in + let env2 = { env with e_funs = tproto::(env.e_funs) } in (* Build local env *) let locales = List.fold_left (* tr = (ty,ref?) *) (fun envir (tr,i) -> Smap.add i tr envir) @@ -599,18 +587,14 @@ let compute_tclass env c = tc_size = 0; tc_hier = { h_class = cls_name; h_pos = 0; h_vtable = []; h_supers = [] } ; tc_members = Smap.empty; tc_methods = []; } in - let forward_env = { - e_globals = env.e_globals; - e_funs = env.e_funs; - e_classes = (Smap.add cls_name forward_def env.e_classes); } in + let forward_env = { env with e_classes = (Smap.add cls_name forward_def env.e_classes); } in let super_list = match c.c_supers with | None -> [] | Some l -> l in let hier, used = let rec move_super diff s = - { h_class = s.h_class; + { s with h_pos = s.h_pos + diff; - h_vtable = s.h_vtable; h_supers = List.map (move_super diff) s.h_supers } in let sup, used = List.fold_left @@ -739,9 +723,7 @@ let compute_decl env d = ty_assert (not (Smap.mem i env.e_globals)) ("Redeclaration of " ^ i); ty_assert (not (List.exists (fun p -> p.tp_name = i) env.e_funs)) ("Redeclaration of: " ^ i ^ ", was previously a function"); (TDGlobal(tr,i)) , - { e_globals = (Smap.add i tr env.e_globals); - e_funs = env.e_funs; - e_classes = env.e_classes } + { env with e_globals = (Smap.add i tr env.e_globals); } (* on voudrait une liste de ident pr decl plsr en meme temps *) | DFunction (p,b) -> ty_assert (not (Smap.mem p.p_name env.e_globals)) ("Redeclaration of: " ^ p.p_name ^ ", was previously a global variable"); @@ -756,9 +738,7 @@ let compute_decl env d = | DClass c -> let tc = compute_tclass env c in (TDClass tc), - { e_globals = env.e_globals; - e_funs = env.e_funs; - e_classes = Smap.add c.c_name tc env.e_classes; } + { env with e_classes = Smap.add c.c_name tc env.e_classes; } ) let prog p = -- cgit v1.2.3 From 8c9a4cd262754b3e24f545235a12839d6adf0bd9 Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Mon, 6 Jan 2014 21:02:52 +0100 Subject: Nothing, use { x with ... } --- src/codegen.ml | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/src/codegen.ml b/src/codegen.ml index b1501fd..1d6d026 100644 --- a/src/codegen.ml +++ b/src/codegen.ml @@ -181,10 +181,9 @@ let rec gen_stmt env = function jal cproto.tp_unique_ident | _ -> push zero in - comment ("declare " ^ id) ++ code, nop, { - c_penv = env.c_penv; + comment ("declare " ^ id) ++ code, nop, + { env with c_names = Smap.add id (VStack pos) env.c_names; - c_ret_ref = env.c_ret_ref; c_fp_used = new_fp_used } | TSDeclareAssignConstructor(cls, id, constr, args) -> let new_fp_used = env.c_fp_used + cls.tc_size in @@ -198,10 +197,9 @@ let rec gen_stmt env = function sub sp sp oi cls.tc_size ++ args_code ++ la a0 areg(pos, fp) ++ push a0 ++ jal constr ++ popn (4 * (List.length args + 1)) in - comment ("declare " ^ id) ++ code, nop, { - c_penv = env.c_penv; + comment ("declare " ^ id) ++ code, nop, + { env with c_names = Smap.add id (VStack pos) env.c_names; - c_ret_ref = env.c_ret_ref; c_fp_used = new_fp_used; } | TSDeclareAssignExpr ((ty, r), id, e) -> let s = if r then 4 else type_size env.c_penv ty in @@ -210,10 +208,9 @@ let rec gen_stmt env = function let pos = - new_fp_used in let code, a = gen_expr env e in assert (a || not r); - comment ("declare " ^ id) ++ sub sp sp oi 4 ++ code ++ cr (a && not r) ++ sw a0 areg (pos, fp), nop, { - c_penv = env.c_penv; + comment ("declare " ^ id) ++ sub sp sp oi 4 ++ code ++ cr (a && not r) ++ sw a0 areg (pos, fp), nop, + { env with c_names = Smap.add id (if r then VStackByRef pos else VStack pos) env.c_names; - c_ret_ref = env.c_ret_ref; c_fp_used = new_fp_used } | TSWriteCout(sl) -> let text1, data1 = List.fold_left @@ -253,10 +250,10 @@ let gen_decl tenv decl = match decl with Smap.add id (if r then VStackByRef p else VStack p) env, p + (type_size tenv ty)) (!globals_env, (match proto.tp_class with | None -> 8 | Some k -> 12)) proto.tp_args in let env = { - c_penv = tenv; - c_names = names; - c_ret_ref = (match proto.tp_ret_type with | None -> false | Some(_, r) -> r); - c_fp_used = 0; + c_penv = tenv; + c_names = names; + c_ret_ref = (match proto.tp_ret_type with | None -> false | Some(_, r) -> r); + c_fp_used = 0; } in let code_for_constructor = match proto.tp_ret_type with | Some _ -> nop -- cgit v1.2.3