aboutsummaryrefslogtreecommitdiff
path: root/projet.ml
diff options
context:
space:
mode:
Diffstat (limited to 'projet.ml')
-rw-r--r--projet.ml17
1 files changed, 16 insertions, 1 deletions
diff --git a/projet.ml b/projet.ml
index d2b66ae..1391508 100644
--- a/projet.ml
+++ b/projet.ml
@@ -41,6 +41,7 @@ let program_of_string str =
41 let lex = Str.split (Str.regexp "[\t\n(),]+") str 41 let lex = Str.split (Str.regexp "[\t\n(),]+") str
42 in List.iter (fun s -> print_string s; print_newline ()) lex; program_of_lex lex 42 in List.iter (fun s -> print_string s; print_newline ()) lex; program_of_lex lex
43 43
44(*Creates a pointer of instruction from an urm command list*)
44let instptr_mk urmcmd_list = 45let instptr_mk urmcmd_list =
45 let rec aux urmcmd_list count acc = 46 let rec aux urmcmd_list count acc =
46 match urmcmd_list with 47 match urmcmd_list with
@@ -48,14 +49,17 @@ let instptr_mk urmcmd_list =
48 | instruction::reste -> aux reste (count + 1) ((count,instruction)::acc) 49 | instruction::reste -> aux reste (count + 1) ((count,instruction)::acc)
49 in InstPtr([],rev (aux urmcmd_list 0 [])) 50 in InstPtr([],rev (aux urmcmd_list 0 []))
50 51
52(*Moves the pointer to the previous instruction*)
51let instptr_move_up = function 53let instptr_move_up = function
52 | InstPtr([],list2)-> InstPtr([],list2) 54 | InstPtr([],list2)-> InstPtr([],list2)
53 | InstPtr(instr::list1,list2) -> InstPtr(list1, instr::list2) 55 | InstPtr(instr::list1,list2) -> InstPtr(list1, instr::list2)
54 56
57(*Moves the pointer to the next instruction*)
55let instptr_move_down = function 58let instptr_move_down = function
56 | InstPtr(list1,[])-> InstPtr(list1,[]) 59 | InstPtr(list1,[])-> InstPtr(list1,[])
57 | InstPtr(list1,instr::list2) -> InstPtr(instr::list1, list2) 60 | InstPtr(list1,instr::list2) -> InstPtr(instr::list1, list2)
58 61
62(*Returns the couple from the current pointer position : (line,instruction) where instruction is an urm command or fails if there is no instruction pointed*)
59let instptr_get = function 63let instptr_get = function
60 | InstPtr(list1,(l,Zero(a))::tail)-> (l,Zero(a)) 64 | InstPtr(list1,(l,Zero(a))::tail)-> (l,Zero(a))
61 | InstPtr(list1,(l,Succ(a))::tail) -> (l,Succ(a)) 65 | InstPtr(list1,(l,Succ(a))::tail) -> (l,Succ(a))
@@ -63,6 +67,7 @@ let instptr_get = function
63 | InstPtr(list1,(l,Jump(a,b,c))::tail) -> (l,Jump(a,b,c)) 67 | InstPtr(list1,(l,Jump(a,b,c))::tail) -> (l,Jump(a,b,c))
64 | InstPtr(_,[])-> failwith "No instruction left" 68 | InstPtr(_,[])-> failwith "No instruction left"
65 69
70(*Converts the current instruction pointed into a string (line and instruction formatted). If there is no instruction, returns "null"*)
66let instptr_string instptr = 71let instptr_string instptr =
67 let aux = function 72 let aux = function
68 | l,Zero(a) -> (string_of_int l)^": Zero "^(string_of_int a) 73 | l,Zero(a) -> (string_of_int l)^": Zero "^(string_of_int a)
@@ -72,11 +77,12 @@ let instptr_string instptr =
72 in try aux (instptr_get instptr) with 77 in try aux (instptr_get instptr) with
73 | _ -> "null" 78 | _ -> "null"
74 79
80(*Returns true if the instruction pointer is not pointing on any instruction (end of the instruction list)*)
75let instptr_end = function 81let instptr_end = function
76 | InstPtr(_,[]) -> true 82 | InstPtr(_,[]) -> true
77 | _ -> false 83 | _ -> false
78 84
79(*Jump ne marche pas dans le cas ou il jump trop loin après la fin*) 85(*Returns the pointer of instruction after a jump decided by the given offset*)
80let rec instptr_jump ptr offset = 86let rec instptr_jump ptr offset =
81if offset = 0 then ptr else 87if offset = 0 then ptr else
82 if offset > 0 then instptr_jump (instptr_move_up ptr) (offset-1) 88 if offset > 0 then instptr_jump (instptr_move_up ptr) (offset-1)
@@ -87,15 +93,22 @@ let reg_idx (Reg(idx, _)) = idx
87 93
88let reg_val (Reg(_, value)) = value 94let reg_val (Reg(_, value)) = value
89 95
96(*Compares two registers. Returns -1 if reg1 is lower than reg2, 1 if it is greater than reg2 or 0 if both are equals.*)
90let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2) 97let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2)
91 98
99(*Returns the value contained in the specified register in a register list*)
92let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x=idx) reglist |> reg_val 100let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x=idx) reglist |> reg_val
93 101
102(*Set the value of the register to value, or creates it to the value specified if it does not exist*)
94let regs_set reglist index value = Reg(index,value)::(List.filter (fun (Reg(x,v))-> x!=index) reglist) 103let regs_set reglist index value = Reg(index,value)::(List.filter (fun (Reg(x,v))-> x!=index) reglist)
95 104
105(*Gives a new urm by moving down its instruction pointer*)
96let urm_move_down urm = {instptr = (instptr_move_down urm.instptr); regs = urm.regs} 106let urm_move_down urm = {instptr = (instptr_move_down urm.instptr); regs = urm.regs}
97 107
108
98(*TODO: Verifier pour JUMP que a et b sont deux registres initialisés*) 109(*TODO: Verifier pour JUMP que a et b sont deux registres initialisés*)
110
111(*Applies the current instruction pointed by the pointer of instruction. Modifies the pointer of instruction for every instruction*)
99let urm_apply urm = 112let urm_apply urm =
100 let aux = function 113 let aux = function
101 | _,Zero(a) -> {instptr = urm.instptr ; regs = regs_set (urm.regs) a 0} |> urm_move_down 114 | _,Zero(a) -> {instptr = urm.instptr ; regs = regs_set (urm.regs) a 0} |> urm_move_down
@@ -106,8 +119,10 @@ let urm_apply urm =
106 | _,_-> {instptr = urm.instptr; regs = urm.regs} |> urm_move_down 119 | _,_-> {instptr = urm.instptr; regs = urm.regs} |> urm_move_down
107 in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr) 120 in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr)
108 121
122(*Launches the URM*)
109let rec urm_run = function 123let rec urm_run = function
110 | {instptr = InstPtr(_,[]); regs = reg_list } -> reg_list 124 | {instptr = InstPtr(_,[]); regs = reg_list } -> reg_list
111 | urm -> urm_apply urm |> urm_run 125 | urm -> urm_apply urm |> urm_run
112 126
127(*Creates an URM from a command list and a register list*)
113let urm_mk cmd_list reg_list = {instptr = (instptr_mk cmd_list) ; regs = reg_list} 128let urm_mk cmd_list reg_list = {instptr = (instptr_mk cmd_list) ; regs = reg_list}