let rec check_block block block_ctx rettype =
  let typing_error has_t used_with_t pos =
    raise (Parse_error("typing error (expression has type " ^ (string_of_type has_t) ^ " but is used with type " ^ (string_of_type used_with_t) ^ ")", pos))
  in
  let undefined_variable_error v =
    raise (Parse_error("variable " ^ v.var_name ^ " is used without having been declared", v.var_pos))
  in
    
    (** Find a definition in a context (i.e. an environment list). *)

  let rec get_def_ctx ctx name =
    match ctx with
      | c :: s ->
          (
            try
              get_def c name
            with
              | Not_found -> get_def_ctx s name
          )
      | [] -> raise Not_found
  in
    
    (** Get the definition of a variable. It uses / fills in var_def. *)

  let get_var_def ctx v =
    match v.var_def with
      | Some d -> d
      | None ->
          try
            let d = get_def_ctx ctx v.var_name in
              v.var_def <- Some d; d
          with
            | Not_found -> undefined_variable_error v
  in
  let get_def_value ctx name =
    (get_def_ctx ctx name).def_value
  in
  let get_var_value ctx v =
    (get_var_def ctx v).def_value
  in
    
    (** Get the type of a variable. It infers it if it was not done before. *)

  let rec get_var_type ctx v =
    if v.var_type = Unknown_type then
      v.var_type <- (get_var_def ctx v).def_type;
    v.var_type
      
      (** Get the nature of a variable. It infers it if it was not done before. *)

  and get_var_nature ctx v =
    if v.var_nature = Unknown_nature then
      v.var_nature <- (get_var_def ctx v).def_nature;
    v.var_nature
  and is_constant = function
    | Cst -> true
    | _ -> false
        
        (** Get the nature of an expression. It infers it if it was not done before. *)

  and get_expr_nature ctx e =
    let is_a_constant v =
      match (get_var_def ctx v).def_value with
        | Constant _ -> true
        | _ -> false
    in
    let score_of_nature = function
      | Cst -> 0
      | Varb -> 1
      | Funct -> 2
      | Unknown_nature -> failwith "trying to get the nature of a not yet typed expression"
    in
    let nature_of_score = function
      | 0 -> Cst
      | 1 -> Varb
      | 2 -> Funct
      | _ -> failwith "internal error"
    in
      match e.expr_val with
        | Lt(e1, e2)
        | Le(e1, e2)
        | Eq(e1, e2)
        | Neq(e1, e2)
        | Plus(e1, e2)
        | Minus(e1, e2)
        | Mult(e1, e2)
        | Div(e1, e2)
        | Mod(e1, e2)
        | And(e1, e2)
        | Or(e1, e2) ->
            nature_of_score (max (score_of_nature (get_expr_nature ctx e1)) (score_of_nature (get_expr_nature ctx e2)))
        | Uminus e
        | Not e -> get_expr_nature ctx e
        | Int _
        | Bool _ -> Cst
        | Var(v, []) when is_a_constant v -> Cst
        | Var(v, _) -> Varb
        | New _
        | Bang _
        | Address_of _
        | Rec _
        | Arr _ -> Varb (* first approximation *)

  and resolve_user_type ctx t =
    let get_user_type_def tn =
      try
        match get_def_value ctx tn with
          | Type t -> t
          | _ -> raise (Parse_error(tn ^ " is not an user type", (-1, -1)))
      with
        | Not_found ->
            raise (Parse_error("user type " ^ tn ^ " is used without having been declared", (-1, -1)))
    in
      match t with
        | User_type tn -> get_user_type_def tn
        | Array(t, i, f) -> Array(resolve_user_type ctx t, i, f)
        | Record l -> Record((List.map (fun (n, t) -> n, resolve_user_type ctx t)) l)
        | Pointer t -> Pointer (resolve_user_type ctx t)
        | _ -> t

  
  (** Get the type of an expression. It infers it if it was not done before. *)

  and get_expr_type ctx e =
    if e.expr_type = Unknown_type then
      e.expr_type <- resolve_user_type ctx
        (
          match e.expr_val with
            | Lt(e1, e2)
            | Le(e1, e2) ->
                let te1 = get_expr_type ctx e1 in
                let te2 = get_expr_type ctx e2 in
                  if te1 <> Integer then
                    typing_error te1 Integer e1.expr_pos
                  else if te2 <> Integer then
                    typing_error te2 Integer e2.expr_pos
                  else Boolean
            | Eq(e1, e2)
            | Neq(e1, e2) ->
                let te1 = get_expr_type ctx e1 in
                let te2 = get_expr_type ctx e2 in
                  if te1 <> Integer && te1 <> Boolean then
                    typing_error te1 te2 e1.expr_pos;
                  if te1 <> te2 then
                    typing_error te1 te2 e1.expr_pos;
                  Boolean
            | Plus(e1, e2)
            | Minus(e1, e2)
            | Mult(e1, e2)
            | Div(e1, e2)
            | Mod(e1, e2) ->
                let te1 = get_expr_type ctx e1 in
                let te2 = get_expr_type ctx e2 in
                  if te1 <> Integer then
                    typing_error te1 Integer e1.expr_pos
                  else if te2 <> Integer then
                    typing_error te2 Integer e2.expr_pos
                  else Integer
            | Uminus e ->
                let te = get_expr_type ctx e in
                  if te <> Integer then
                    typing_error te Integer e.expr_pos
                  else Integer
            | And(e1, e2)
            | Or(e1, e2) ->
                let te1 = get_expr_type ctx e1 in
                let te2 = get_expr_type ctx e2 in
                  if te1 <> Boolean then
                    typing_error te1 Boolean e1.expr_pos
                  else if te2 <> Boolean then
                    typing_error te2 Boolean e2.expr_pos
                  else Boolean
            | Not e ->
                let te = get_expr_type ctx e in
                  if te <> Boolean then
                    typing_error te Boolean e.expr_pos
                  else Boolean
            | Int _ -> Integer
            | Bool _ -> Boolean
            | Arr(e1, e2) ->
                if get_expr_type ctx e2 <> Integer then
                  raise (Parse_error("typing error (integer expected)", e2.expr_pos))
                else
                  (
                    match get_expr_type ctx e1 with
                      | Array(t, _, _) -> t
                      | t -> raise (Parse_error("typing error (array expected)", e.expr_pos))
                  )
            | Rec(e1, m) ->
                (
                  match get_expr_type ctx e1 with
                    | Record l ->
                        (
                          try
                            List.assoc m l
                          with
                            | Not_found -> raise (Parse_error("no such member", e1.expr_pos))
                        )
                    | _ -> raise (Parse_error("typing error (record expected)", e1.expr_pos))
                )
            | Var(v, []) ->
                get_var_type ctx v
            | Var(v, a) ->
                (
                  try
                    match get_var_value ctx v with
                      | Function f ->
                          (
                            try
                              List.iter2
                                (fun d e ->
                                   if
                                     (
                                       if d.def_pass_by_ref then
                                         match d.def_type with
                                           | Pointer t -> t
                                           | _ -> raise (Parse_error("internal error (pointer expected for by ref)", v.var_pos))
                                       else
                                         d.def_type
                                     )
                                     <> get_expr_type ctx e then
                                       raise (Parse_error("typing error", e.expr_pos))
                                ) f.func_args a;
                              get_var_type ctx v
                            with
                              | Invalid_argument _ -> raise (Parse_error("wrong number of arguments", v.var_pos))
                          );
                      | _ -> raise (Parse_error("typing error (function expected)", v.var_pos))
                  with
                    | Not_found ->
                        raise (Parse_error("procedure " ^ v.var_name ^ " is used without having been declared", v.var_pos))
                )
            | Address_of e ->
                Pointer (get_expr_type ctx e)
            | Bang e ->
                (
                  match get_expr_type ctx e with
                    | Pointer t -> t
                    | _ -> raise (Parse_error("typing error (pointer expected)", e.expr_pos))
                )
            | New t ->
                t := resolve_user_type ctx !t;
                Pointer !t
        );
    e.expr_type
  in
    
    (** Check a statement list in a context. *)

  let rec check_statement ctx stt =
    match stt.stt_value with
      | Assign(n, e) ->
          let tn = get_expr_type ctx n
          and te = get_expr_type ctx e in
            if tn <> te then typing_error te tn e.expr_pos
      | Compound l -> List.iter (check_statement ctx) l
      | While(e, s) ->
          if get_expr_type ctx e <> Boolean then
            raise (Parse_error("typing error (boolean expected)", e.expr_pos))
          else
            check_statement ctx s
      | If(e, s1, s2) ->
          if get_expr_type ctx e <> Boolean then
            raise (Parse_error("typing error (boolean expected)", e.expr_pos))
          else
            (
              check_statement ctx s1;
              check_statement ctx s2
            )
      | Return(e) ->
          if get_expr_type ctx e <> rettype then
            raise (Parse_error("typing error (" ^ string_of_type rettype ^ " expected)", e.expr_pos))
      | Proc(v, l) ->
          (
            try
              match get_var_value ctx v with
                | Function f ->
                    (
                      try
                        List.iter2
                          (fun d e ->
                             if
                               (
                                 if d.def_pass_by_ref then
                                   match d.def_type with
                                     | Pointer t -> t
                                     | _ -> raise (Parse_error("internal error (pointer expected for by ref)", v.var_pos))
                                 else
                                   d.def_type
                               )
                               <> get_expr_type ctx e then
                                 raise (Parse_error("typing error", e.expr_pos))
                          ) f.func_args l;
                        if get_var_type ctx v <> Unit then
                          Log.warning ("Discading the value of a function line " ^ (string_of_int (fst stt.stt_pos)))
                      with
                        | Invalid_argument _ -> raise (Parse_error("wrong number of arguments", stt.stt_pos))
                    );
                | _ -> raise (Parse_error("typing error (procedure expected)", stt.stt_pos))
            with
              | Not_found ->
                  raise (Parse_error("procedure " ^ v.var_name ^ " is used without having been declared", v.var_pos))
          )
      | Delete _ (* TODO: we could check that it is allocated by a new *)
      | Noop -> ()
  in
  let ctx = ref block_ctx in
  let cur_env = ref (create_environment ()) in
  let resolve_user_type t = resolve_user_type !ctx t in    
  let resolve_def_user_type d =
    d.def_type <-
    (
      try
        resolve_user_type d.def_type
      with
        | Parse_error(e, _) -> raise (Parse_error(e, d.def_pos))
    )
  in
    iter_env
      (fun n d ->
         (
           match d.def_value with
             | Type t ->
                 (
                   try
                     d.def_value <- Type(resolve_user_type t)
                   with
                     | Parse_error(e, _) -> raise (Parse_error(e, d.def_pos))
                 )
             | _ -> ()
         );
         resolve_def_user_type d;
         (
           match d.def_value with
             | Function f ->
                 List.iter resolve_def_user_type f.func_args;
                 List.iter2 (fun a b -> b.Asm_ir.vd_type := asm_type a.def_type) f.func_args f.func_asm_def.Asm_ir.proc_args;
                 check_block f.func_value (add_def !cur_env n d :: !ctx) d.def_type (* TODO: is that the good environment? *)
             | Constant e ->
                 if not (is_constant (get_expr_nature !ctx e)) then
                   raise (Parse_error("typing error (constant expression expected)", e.expr_pos));
                 d.def_type <- get_expr_type !ctx e
             | Type t ->
                 (
                   match t with
                     | Array(t, i, f) ->
                         if get_expr_type !ctx i <> Integer then
                           raise (Parse_error("typing error (integer expected)", i.expr_pos))
                         else if get_expr_type !ctx f <> Integer then
                           raise (Parse_error("typing error (integer expected)", f.expr_pos))
                         else if not (is_constant (get_expr_nature !ctx i)) then
                           raise (Parse_error("typing error (constant expression expected)", i.expr_pos))
                         else if not (is_constant (get_expr_nature !ctx f)) then
                           raise (Parse_error("typing error (constant expression expected)", f.expr_pos))
                     | Record _ -> ()
                     | _ -> raise (Parse_error("internal error (user type other than array or record defined)", d.def_pos))
                 )
             | Variable -> ()
         );
         cur_env := add_def !cur_env n d;
         ctx := !cur_env :: block_ctx
      ) block.block_env;
    List.iter (check_statement (block.block_env :: block_ctx)) block.block_stts