(**************************************************************************)
(*  This file is part of BINSEC.                                          *)
(*                                                                        *)
(*  Copyright (C) 2016-2021                                               *)
(*    CEA (Commissariat à l'énergie atomique et aux énergies              *)
(*         alternatives)                                                  *)
(*                                                                        *)
(*  you can redistribute it and/or modify it under the terms of the GNU   *)
(*  Lesser General Public License as published by the Free Software       *)
(*  Foundation, version 2.1.                                              *)
(*                                                                        *)
(*  It is distributed in the hope that it will be useful,                 *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU Lesser General Public License for more details.                   *)
(*                                                                        *)
(*  See the GNU Lesser General Public License version 2.1                 *)
(*  for more details (enclosed in the file licenses/LGPLv2.1).            *)
(*                                                                        *)
(**************************************************************************)

class type inplace_visitor_t =
  object
    method visit_assert : Dba.Expr.t -> unit

    method visit_assign : Dba.LValue.t -> Dba.Expr.t -> unit

    method visit_assume : Dba.Expr.t -> unit

    method visit_binary : Dba.Binary_op.t -> Dba.Expr.t -> Dba.Expr.t -> unit

    method visit_cond : Dba.Expr.t -> unit

    method visit_cst : Bitvector.t -> unit

    method visit_dbainstr : Dba_types.Statement.t -> unit

    method visit_djump : Dba.Expr.t -> unit

    method visit_expr : Dba.Expr.t -> unit

    method visit_exts : Dba.Expr.t -> Dba.size -> unit

    method visit_extu : Dba.Expr.t -> Dba.size -> unit

    method visit_free : Dba.Expr.t -> unit

    method visit_if : Dba.Expr.t -> Dba.id Dba.jump_target -> Dba.id -> unit

    method visit_instrkind : Dba.Instr.t -> unit

    method visit_ite : Dba.Expr.t -> Dba.Expr.t -> Dba.Expr.t -> unit

    method visit_lhs : Dba.LValue.t -> unit

    method visit_lhs_var :
      string -> Dba.size -> Dba.id -> Dba.id -> Dba.VarTag.t -> unit

    method visit_load : Dba.size -> Machine.endianness -> Dba.Expr.t -> unit

    method visit_local_if : Dba.Expr.t -> Dba.id -> Dba.id -> unit

    method visit_malloc : Dba.LValue.t -> Dba.Expr.t -> unit

    method visit_nondet : Dba.LValue.t -> unit

    method visit_nondet_assume : Dba.LValue.t list -> Dba.Expr.t -> unit

    method visit_remote_if : Dba.Expr.t -> Dba.address -> Dba.id -> unit

    method visit_restrict : Dba.Expr.t -> Dba.id -> Dba.id -> unit

    method visit_sjump : Dba.id Dba.jump_target -> Dba.tag option -> unit

    method visit_stop : Dba.state option -> unit

    method visit_store : Dba.size -> Machine.endianness -> Dba.Expr.t -> unit

    method visit_unary : Dba.Unary_op.t -> Dba.Expr.t -> unit

    method visit_undef : Dba.LValue.t -> unit

    method visit_var : string -> Dba.size -> Dba.VarTag.t -> unit
  end

class dba_inplace_visitor : inplace_visitor_t =
  (* Visitor to visit an smt expression without changing anything *)
  object (self)
    method visit_expr (expr : Dba.Expr.t) : unit =
      match expr with
      | Dba.Expr.Cst bv -> self#visit_cst bv
      | Dba.(Expr.Var { name; size = sz; info = opts }) ->
          self#visit_var name sz opts
      | Dba.Expr.Load (sz, en, expr) ->
          self#visit_load sz en expr;
          self#visit_expr expr
      | Dba.Expr.Unary (Dba.Unary_op.Uext n, expr) ->
          self#visit_extu expr n;
          self#visit_expr expr
      | Dba.Expr.Unary (Dba.Unary_op.Sext n, expr) ->
          self#visit_exts expr n;
          self#visit_expr expr
      | Dba.Expr.Unary
          (Dba.Unary_op.Restrict { Interval.lo = i; Interval.hi = j }, expr) ->
          self#visit_restrict expr i j;
          self#visit_expr expr
      | Dba.Expr.Unary (uop, expr) ->
          self#visit_unary uop expr;
          self#visit_expr expr
      | Dba.Expr.Binary (bop, expr1, expr2) ->
          self#visit_binary bop expr1 expr2;
          self#visit_expr expr1;
          self#visit_expr expr2
      | Dba.Expr.Ite (cond, e1, e2) ->
          self#visit_ite cond e1 e2;
          self#visit_cond cond;
          self#visit_expr e1;
          self#visit_expr e2

    method visit_cond cond = self#visit_expr cond

    method visit_lhs (lhs : Dba.LValue.t) : unit =
      match lhs with
      | Dba.(LValue.Var { name; size = sz; info = opts }) ->
          self#visit_lhs_var name sz 0 (sz - 1) opts
      | Dba.LValue.Restrict (v, { Interval.lo; Interval.hi }) ->
          self#visit_lhs_var v.Dba.name v.Dba.size lo hi Dba.VarTag.Empty
      | Dba.LValue.Store (sz, en, e) ->
          self#visit_store sz en e;
          self#visit_expr e

    method visit_instrkind (inst : Dba.Instr.t) : unit =
      match inst with
      | Dba.Instr.Assign (lhs, expr, _) ->
          self#visit_assign lhs expr;
          self#visit_lhs lhs;
          self#visit_expr expr
      | Dba.Instr.SJump (addr, opts) -> self#visit_sjump addr opts
      | Dba.Instr.DJump (expr, _) ->
          self#visit_djump expr;
          self#visit_expr expr
      | Dba.Instr.If (cond, addr, off2) -> (
          self#visit_if cond addr off2;
          self#visit_cond cond;
          match addr with
          | Dba.JInner off1 -> self#visit_local_if cond off1 off2
          | Dba.JOuter addr -> self#visit_remote_if cond addr off2)
      | Dba.Instr.Stop opts -> self#visit_stop opts
      | Dba.Instr.Print (_, _) -> ()
      | Dba.Instr.NondetAssume (l, cond, _) ->
          self#visit_nondet_assume l cond;
          List.iter self#visit_lhs l;
          self#visit_cond cond
      | Dba.Instr.Nondet (lhs, _, _) ->
          self#visit_nondet lhs;
          self#visit_lhs lhs
      | Dba.Instr.Assume (bcond, _) ->
          self#visit_assume bcond;
          self#visit_cond bcond
      | Dba.Instr.Assert (bcond, _) ->
          self#visit_assert bcond;
          self#visit_cond bcond
      | Dba.Instr.Malloc (lhs, bexpr, _) ->
          self#visit_malloc lhs bexpr;
          self#visit_lhs lhs;
          self#visit_expr bexpr
      | Dba.Instr.Free (bexpr, _) ->
          self#visit_free bexpr;
          self#visit_expr bexpr
      | Dba.Instr.Undef (blhs, _) ->
          self#visit_undef blhs;
          self#visit_lhs blhs

    method visit_dbainstr (instr : Dba_types.Statement.t) : unit =
      self#visit_instrkind (Dba_types.Statement.instruction instr)

    method visit_cst (_bv : Bitvector.t) : unit = ()

    method visit_var (_name : string) (_sz : Dba.size) _opts : unit = ()

    method visit_load (_sz : Dba.size) (_en : Machine.endianness)
        (_expr : Dba.Expr.t) =
      ()

    method visit_unary (_uop : Dba.Unary_op.t) (_expr : Dba.Expr.t) : unit = ()

    method visit_binary (_bop : Dba.Binary_op.t) (_expr1 : Dba.Expr.t)
        (_expr2 : Dba.Expr.t) : unit =
      ()

    method visit_restrict (_expr : Dba.Expr.t) (_ : Dba.id) (_j : Dba.id) : unit
        =
      ()

    method visit_extu (_expr : Dba.Expr.t) (_size : Dba.size) : unit = ()

    method visit_exts (_expr : Dba.Expr.t) (_size : Dba.size) : unit = ()

    method visit_ite _ _ _ = ()

    method visit_lhs_var (_name : string) (_size : Dba.size) _low _high _tag =
      ()

    method visit_store (_size : Dba.size) (_en : Machine.endianness)
        (_expr : Dba.Expr.t) : unit =
      ()

    method visit_assign (_lhs : Dba.LValue.t) (_expr : Dba.Expr.t) : unit = ()

    method visit_sjump _addr (_opts : Dba.tag option) : unit = ()

    method visit_djump (_expr : Dba.Expr.t) : unit = ()

    method visit_if _ _addr (_off2 : Dba.id) : unit = ()

    method visit_local_if _ (_off1 : Dba.id) (_off2 : Dba.id) : unit = ()

    method visit_remote_if _ (_addr : Dba.address) (_off2 : Dba.id) : unit = ()

    method visit_stop _state_option = ()

    method visit_nondet_assume _lvalues _ = ()

    method visit_nondet (_lhs : Dba.LValue.t) : unit = ()

    method visit_assume _cond : unit = ()

    method visit_assert _cond : unit = ()

    method visit_malloc (_lhs : Dba.LValue.t) (_expr : Dba.Expr.t) : unit = ()

    method visit_free (_expr : Dba.Expr.t) : unit = ()

    method visit_undef _lvalue = ()
  end