src/urm.ml


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

(*
 * UPEM / L3 / Functional programming / Project: URM
 * Pacien TRAN-GIRARD, Adam NAILI
 *)

open Common
open Instptr
open Reg

(* Gives a new urm by moving down its instruction pointer *)
let urm_move_down urm = { instptr = instptr_move_down urm.instptr ; regs = urm.regs }

(* TODO: Verifier pour JUMP que a et b sont deux registres initialisés *)

(* Applies the current instruction pointed by the pointer of instruction. Modifies the pointer of instruction for every instruction *)
let urm_apply urm =
  let aux = function
    | _, URMZero(a) -> { instptr = urm.instptr ; regs = regs_set (urm.regs) a 0 } |> urm_move_down
    | _, URMCopy(a, b) when a != b -> { instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b) } |> urm_move_down
    | _, URMCopy(a, b) -> failwith "Copy from one register to itself"
    | _, URMSucc(a) -> { instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a) + 1) } |> urm_move_down
    | _, URMJump(a, b, c) when (regs_get urm.regs a) = (regs_get urm.regs b) -> { instptr = (instptr_jump urm.instptr (fst (instptr_get urm.instptr) - c)) ; regs = urm.regs }
    | _, _ -> { instptr = urm.instptr ; regs = urm.regs } |> urm_move_down
  in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr)

let rec urm_run_pre pre = function
  | { instptr = InstPtr(_, []) ; regs = reg_list } -> reg_list
  | urm -> pre urm; urm_apply urm |> urm_run_pre pre

let urm_run = urm_run_pre (fun _ -> ())

let urm_run_trace =
  let print_func u =
    print_endline (instptr_string u.instptr);
    print_endline (regs_string u.regs);
    print_newline ()
  in urm_run_pre (print_func)

(* Creates an URM from a command list and a register list *)
let urm_mk cmd_list reg_list = { instptr = (instptr_mk cmd_list) ; regs = reg_list }