[PTR] merge with Type

src/e_regexp.ml

@@ -69,8 +69,9 @@ let list_regexp : (regexp * (string -> token option)) list =
     (keyword_regexp "while",    fun s -> Some (SYM_WHILE));
     (keyword_regexp "int", fun s -> Some (SYM_INT));
     (* begin TODO *)
-    (*(keyword_regexp "print",       fun s -> Some (SYM_PRINT));*)
+    (keyword_regexp "char", fun s -> Some (SYM_CHAR));
     (keyword_regexp "void",       fun s -> Some (SYM_VOID));
+    (*(keyword_regexp "print",       fun s -> Some (SYM_PRINT));*)
     (keyword_regexp "if",         fun s -> Some (SYM_IF));
     (keyword_regexp "else",       fun s -> Some (SYM_ELSE));
     (keyword_regexp "return",       fun s -> Some (SYM_RETURN));

src/elang_gen.ml

@@ -54,13 +54,13 @@ let binop_of_tag =
 let compatible_types (t1 : typ) (t2 : typ) :bool * typ =
   match t1,t2 with
   |t1',t2' when t1'=t2' -> true,t1'
-  |Tchar,Tint -> true,Tint
-  |Tint,Tchar -> true,Tint
+  |Tchar,Tint -> true,Tchar
+  |Tint,Tchar -> true,Tchar
   |Tptr(_),Tint -> true,t1
   |Tint,Tptr(_) -> true,t2
   |Tptr(_),Tchar -> true,t1
   |Tchar,Tptr(_) -> true,t2  
-  |_,_ -> false,t1
+  |_,_ -> false,Tvoid
 
 
 
@@ -94,13 +94,15 @@ let rec type_and_name_of_node (tree0 : tree) (typ_var : (string,typ) Hashtbl.t):
     
     | Evar(name) -> option_to_res_bind (Hashtbl.find_option typ_var name) (Format.sprintf "Unrecognized variable '%s'" name) (fun t -> OK(t))
     
-    | Ebinop(b,expr1,expr2) -> type_expr typ_var typ_fun expr1 >>= fun t1 -> 
-    type_expr typ_var typ_fun expr2 >>= fun t2 ->
-      if fst(compatible_types t1 t2) 
-        then OK(snd(compatible_types t1 t2)) 
-        else Error (Format.sprintf "Error type : "^(dump_eexpr expr1)^" is of type "^(string_of_typ t1)^" while "^(dump_eexpr expr2)^" is of type "^(string_of_typ t2)) 
-    
-    | Eunop(u,expr) -> type_expr typ_var typ_fun expr
+    |Ebinop(b,expr1,expr2) -> 
+      type_expr typ_var typ_fun expr1 >>= fun t1 -> 
+      type_expr typ_var typ_fun expr2 >>= fun t2 ->
+        let bool,type_ret = compatible_types t1 t2 in
+        if bool
+          then OK(type_ret) 
+          else Error (Format.sprintf "Error type : "^(dump_eexpr expr1)^" is of type "^(string_of_typ t1)^" while "^(dump_eexpr expr2)^" is of type "^(string_of_typ t2)) 
+      
+    |Eunop(u,expr) -> type_expr typ_var typ_fun expr
     
     | Ecall(fname,expr_list) -> option_to_res_bind (Hashtbl.find_option typ_fun fname) (Format.sprintf "%s is undefined" fname) (fun (typ_list,typ_ret) ->
       let rec aux expr_list typ_list typ_ret =
@@ -140,8 +142,8 @@ let rec make_eexpr_of_ast (a: tree) (typ_var : (string,typ) Hashtbl.t) (typ_fun
     
     | Node(t, [e1; e2]) when tag_is_binop t -> 
       make_eexpr_of_ast e1 typ_var typ_fun >>= fun expr1 -> 
-        make_eexpr_of_ast e2 typ_var typ_fun >>= fun expr2 -> 
-          type_expr typ_var typ_fun (Ebinop(binop_of_tag t,expr1,expr2)) >>= fun _ ->
+      make_eexpr_of_ast e2 typ_var typ_fun >>= fun expr2 -> 
+      type_expr typ_var typ_fun (Ebinop(binop_of_tag t,expr1,expr2)) >>= fun _ ->
           OK(Ebinop(binop_of_tag t,expr1,expr2))
     
     | Node(t,[e]) when tag_is_unop t-> make_eexpr_of_ast e typ_var typ_fun >>= fun expr -> 
@@ -202,8 +204,9 @@ let rec make_einstr_of_ast (a: tree) (typ_var : (string,typ) Hashtbl.t) (typ_fun
         make_eexpr_of_ast e typ_var typ_fun >>= fun expr -> 
         type_expr typ_var typ_fun expr >>= fun t' ->
         typ_of_tag t >>= fun t ->
-          if fst(compatible_types t t') 
-            then begin Hashtbl.replace typ_var i t;  OK(Iassign(i,expr)) end (*Hashtbl.replace typ_var i (snd(compatible_types t t'))*)
+          let bool,type_ret = compatible_types t t' in
+          if bool
+            then begin Hashtbl.replace typ_var i type_ret;  OK(Iassign(i,expr)) end
             else Error(Format.sprintf "Uncompatible types : type '%s' of '%s' can not match with type '%s' of expression %s"  (string_of_typ t) i (string_of_typ t') (dump_eexpr expr)) 
     
     (*VARIABLE : definition without value*)
@@ -250,8 +253,9 @@ let rec make_einstr_of_ast (a: tree) (typ_var : (string,typ) Hashtbl.t) (typ_fun
       type_expr typ_var typ_fun (Evar(i)) >>= fun t -> 
       make_eexpr_of_ast e typ_var typ_fun >>= fun expr ->
       type_expr typ_var typ_fun expr >>= fun t' ->
-        if fst (compatible_types t t') 
-          then begin Hashtbl.replace typ_var i t;  OK(Iassign(i,expr)) end (*Hashtbl.replace typ_var i (snd(compatible_types t t'))*)
+        let bool,type_ret = compatible_types t t' in
+        if bool 
+          then begin Hashtbl.replace typ_var i type_ret;  OK(Iassign(i,expr)) end
           else Error(Format.sprintf "Uncompatible types : type '%s' of '%s' can not match with type '%s' of expression %s" (string_of_typ t) i (string_of_typ t') (dump_eexpr expr))