aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAdam NAILI2018-04-20 19:44:04 +0200
committerAdam NAILI2018-04-20 19:44:04 +0200
commitc2a0688087a91dba700e8a6a1cdd1c52b8b8397e (patch)
tree5ef0946b0a7438b33ac71f9379c4aec708c5ad56
parent35b808e5a3ba0a70f72b67c5690af78f86fe0c29 (diff)
downloadurm-c2a0688087a91dba700e8a6a1cdd1c52b8b8397e.tar.gz
urm_run working + a lot of subfunctionnalities
-rw-r--r--projet.ml44
1 files changed, 26 insertions, 18 deletions
diff --git a/projet.ml b/projet.ml
index 6fd13ea..d2b66ae 100644
--- a/projet.ml
+++ b/projet.ml
@@ -72,34 +72,42 @@ let instptr_string instptr =
72 in try aux (instptr_get instptr) with 72 in try aux (instptr_get instptr) with
73 | _ -> "null" 73 | _ -> "null"
74 74
75let instptr_end = function
76 | InstPtr(_,[]) -> true
77 | _ -> false
75 78
76let reg_idx = function 79(*Jump ne marche pas dans le cas ou il jump trop loin après la fin*)
77 | Reg(a,b) -> a 80let rec instptr_jump ptr offset =
81if offset = 0 then ptr else
82 if offset > 0 then instptr_jump (instptr_move_up ptr) (offset-1)
83 else instptr_jump (instptr_move_down ptr) (offset+1)
78 84
79let reg_val = function
80 | Reg(a,b) -> b
81 85
82let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2) 86let reg_idx (Reg(idx, _)) = idx
87
88let reg_val (Reg(_, value)) = value
83 89
84let regs_get reglist idx = 90let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2)
85 let rec aux = function
86 | [] -> failwith "Register not found"
87 | Reg(i,v)::tail when i = idx -> v
88 | Reg(_,_)::tail -> aux tail
89 in aux reglist
90 91
91let regs_exists regs idx = List.exists (fun (Reg(x,_)) -> x = idx) regs 92let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x=idx) reglist |> reg_val
92 93
93(*TODO: Function of register manipulation: create a register or modify an existent register (remove + create?)*) 94let regs_set reglist index value = Reg(index,value)::(List.filter (fun (Reg(x,v))-> x!=index) reglist)
94 95
96let urm_move_down urm = {instptr = (instptr_move_down urm.instptr); regs = urm.regs}
95 97
98(*TODO: Verifier pour JUMP que a et b sont deux registres initialisés*)
96let urm_apply urm = 99let urm_apply urm =
97 let aux = function 100 let aux = function
98 | _,Zero(a) -> urm.regs 101 | _,Zero(a) -> {instptr = urm.instptr ; regs = regs_set (urm.regs) a 0} |> urm_move_down
99 in aux (instptr_get urm.instptr) 102 | _,Copy(a,b) when a!=b -> {instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b)} |> urm_move_down
100 103 | _,Copy(a,b) -> failwith "Copy from one register to itself"
101let urm_run urm = 104 | _,Succ(a) -> {instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a)+1)} |> urm_move_down
102 match urm with 105 | _,Jump(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}
106 | _,_-> {instptr = urm.instptr; regs = urm.regs} |> urm_move_down
107 in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr)
108
109let rec urm_run = function
103 | {instptr = InstPtr(_,[]); regs = reg_list } -> reg_list 110 | {instptr = InstPtr(_,[]); regs = reg_list } -> reg_list
111 | urm -> urm_apply urm |> urm_run
104 112
105let urm_mk cmd_list reg_list = {instptr = (instptr_mk cmd_list) ; regs = reg_list} 113let urm_mk cmd_list reg_list = {instptr = (instptr_mk cmd_list) ; regs = reg_list}