(* ==============================================
   Compilation vers bytecode et machine virtuelle
   ============================================== *)

(* On reprend le type expression du cours precedent *)
type expr =
  | Int of int
  | Add of expr * expr
  | Sub of expr * expr
  | Mul of expr * expr

(* Evaluation directe (rappel) *)
let rec eval e = match e with
  | Int n -> n
  | Add (a, b) -> eval a + eval b
  | Sub (a, b) -> eval a - eval b
  | Mul (a, b) -> eval a * eval b

(* -------------------------------------------------
   1. Bytecode symbolique (notation postfixee)
   ------------------------------------------------- *)

type instr =
  | PUSH of int
  | ADD
  | SUB
  | MUL

(* Compilation : expr -> instr list *)
let rec compile e = match e with
  | Int n -> [PUSH n]
  | Add (a, b) -> compile a @ compile b @ [ADD]
  | Sub (a, b) -> compile a @ compile b @ [SUB]
  | Mul (a, b) -> compile a @ compile b @ [MUL]

(* Affichage lisible du bytecode *)
let show_instr i = match i with
  | PUSH n -> Printf.sprintf "PUSH %d" n
  | ADD -> "ADD"
  | SUB -> "SUB"
  | MUL -> "MUL"

let show_code code =
  List.iter (fun i -> Printf.printf "  %s\n" (show_instr i)) code

(* -------------------------------------------------
   2. Executeur a pile (liste d'entiers)
   ------------------------------------------------- *)

let exec code =
  let rec loop stack = function
    | [] ->
      (match stack with
       | [r] -> r
       | _ -> failwith "pile invalide en fin d'execution")
    | PUSH n :: rest -> loop (n :: stack) rest
    | ADD :: rest ->
      (match stack with
       | a :: b :: s -> loop (b + a :: s) rest
       | _ -> failwith "ADD: pile sous-dimensionnee")
    | SUB :: rest ->
      (match stack with
       | a :: b :: s -> loop (b - a :: s) rest
       | _ -> failwith "SUB: pile sous-dimensionnee")
    | MUL :: rest ->
      (match stack with
       | a :: b :: s -> loop (b * a :: s) rest
       | _ -> failwith "MUL: pile sous-dimensionnee")
  in
  loop [] code

(* -------------------------------------------------
   3. Code binaire (opcodes)
   ------------------------------------------------- *)

(* Format : chaque instruction est encodee sur un ou plusieurs entiers
     PUSH n  -> 0, n        (2 mots)
     ADD     -> 1            (1 mot)
     SUB     -> 2            (1 mot)
     MUL     -> 3            (1 mot)
*)

let assemble instrs =
  let rec go acc = function
    | [] -> List.rev acc
    | PUSH n :: rest -> go (n :: 0 :: acc) rest
    | ADD :: rest -> go (1 :: acc) rest
    | SUB :: rest -> go (2 :: acc) rest
    | MUL :: rest -> go (3 :: acc) rest
  in
  go [] instrs

let show_binary code =
  Printf.printf "  [";
  List.iteri (fun i w ->
    if i > 0 then Printf.printf "; ";
    Printf.printf "%d" w
  ) code;
  Printf.printf "]\n"

(* -------------------------------------------------
   4. Processeur virtuel
   ------------------------------------------------- *)

(* Le processeur a :
   - un pointeur d'instruction (ip) dans la memoire
   - une pile (stack) : liste d'entiers
   - une memoire de programme (code) : tableau d'entiers
*)
type cpu = {
  ip : int;               (* pointeur d'instruction *)
  stack : int list;       (* pile *)
  code : int array;       (* memoire de programme *)
}

(* Initialiser le processeur avec un code binaire *)
let load code = { ip = 0; stack = []; code = Array.of_list code }

(* Decoder et executer une instruction, retourner le nouvel etat *)
let step cpu =
  let c = cpu.code in
  let ip = cpu.ip in
  if ip >= Array.length c then
    failwith "processeur: pointeur hors memoire"
  else match c.(ip) with
  | 0 -> (* PUSH n *)
    let n = c.(ip + 1) in
    { cpu with ip = ip + 2; stack = n :: cpu.stack }
  | 1 -> (* ADD *)
    (match cpu.stack with
     | a :: b :: s -> { cpu with ip = ip + 1; stack = b + a :: s }
     | _ -> failwith "CPU ADD: pile sous-dimensionnee")
  | 2 -> (* SUB *)
    (match cpu.stack with
     | a :: b :: s -> { cpu with ip = ip + 1; stack = b - a :: s }
     | _ -> failwith "CPU SUB: pile sous-dimensionnee")
  | 3 -> (* MUL *)
    (match cpu.stack with
     | a :: b :: s -> { cpu with ip = ip + 1; stack = b * a :: s }
     | _ -> failwith "CPU MUL: pile sous-dimensionnee")
  | op -> failwith (Printf.sprintf "CPU: opcode inconnu %d" op)

(* Executer jusqu'a la fin et retourner le resultat *)
let rec run cpu =
  if cpu.ip >= Array.length cpu.code then
    match cpu.stack with
    | [r] -> r
    | _ -> failwith "CPU: pile invalide en fin de programme"
  else
    run (step cpu)

(* Desassembleur : binaire -> instructions symboliques *)
let disassemble bin =
  let rec go acc ip =
    if ip >= Array.length bin then List.rev acc
    else match bin.(ip) with
    | 0 -> go (PUSH bin.(ip + 1) :: acc) (ip + 2)
    | 1 -> go (ADD :: acc) (ip + 1)
    | 2 -> go (SUB :: acc) (ip + 1)
    | 3 -> go (MUL :: acc) (ip + 1)
    | n -> failwith (Printf.sprintf "opcode inconnu %d a l'adresse %d" n ip)
  in
  go [] 0

(* Trace pas-a-pas du CPU *)
let rec trace cpu =
  let show_stack s = "[" ^ String.concat "; " (List.map string_of_int s) ^ "]" in
  if cpu.ip >= Array.length cpu.code then begin
    match cpu.stack with
    | [r] ->
      Printf.printf "  FINI  stack = %s  => %d\n" (show_stack cpu.stack) r;
      r
    | _ -> failwith "CPU: pile invalide en fin de programme"
  end else begin
    let instr_str =
      match cpu.code.(cpu.ip) with
      | 0 -> Printf.sprintf "PUSH %d" cpu.code.(cpu.ip + 1)
      | 1 -> "ADD"
      | 2 -> "SUB"
      | 3 -> "MUL"
      | n -> Printf.sprintf "??? %d" n
    in
    Printf.printf "  ip=%d  instr=%-8s  stack=%s\n"
      cpu.ip instr_str (show_stack cpu.stack);
    trace (step cpu)
  end

(* -------------------------------------------------
   5. Tests
   ------------------------------------------------- *)

let () =
  (* Expression : (3 + 4) * (10 - 2) *)
  let e = Mul (Add (Int 3, Int 4), Sub (Int 10, Int 2)) in

  Printf.printf "Expression : ((3 + 4) * (10 - 2))\n";
  Printf.printf "Evaluation directe : %d\n\n" (eval e);

  (* Bytecode symbolique *)
  let code = compile e in
  Printf.printf "Bytecode symbolique :\n";
  show_code code;
  Printf.printf "Execution : %d\n\n" (exec code);

  (* Code binaire *)
  let bin = assemble code in
  Printf.printf "Code binaire :\n";
  show_binary bin;
  Printf.printf "Taille : %d mots\n\n" (List.length bin);

  (* CPU virtuel *)
  let cpu = load bin in
  let r = run cpu in
  Printf.printf "CPU virtuel : %d\n\n" r;

  (* Verification : desassembleur *)
  let decoded = disassemble (Array.of_list bin) in
  Printf.printf "Desassembleur :\n";
  List.iter (fun i -> Printf.printf "  %s\n" (show_instr i)) decoded;
  Printf.printf "\n";

  (* Trace pas-a-pas *)
  Printf.printf "Trace d'execution :\n";
  let cpu2 = load bin in
  let _ = trace cpu2 in
  Printf.printf "\n";

  (* Autres expressions *)
  let tests = [
    "3 + 5", Add (Int 3, Int 5);
    "10 - 3", Sub (Int 10, Int 3);
    "2 * 6", Mul (Int 2, Int 6);
    "(1 + 2) * (3 + 4)", Mul (Add (Int 1, Int 2), Add (Int 3, Int 4));
    "(2 + 3) * (10 - 6)", Mul (Add (Int 2, Int 3), Sub (Int 10, Int 6));
  ] in
  List.iter (fun (desc, e) ->
    let c = compile e in
    let b = assemble c in
    let cpu = load b in
    Printf.printf "%-30s = %d\n" desc (run cpu)
  ) tests