aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--projet.ml176
1 files changed, 86 insertions, 90 deletions
diff --git a/projet.ml b/projet.ml
index 1391508..1de9e53 100644
--- a/projet.ml
+++ b/projet.ml
@@ -1,128 +1,124 @@
1#load "str.cma";; 1#load "str.cma";;
2open List;; 2
3(*line number*) 3open List
4
4type line = int 5type line = int
5(*register index*)
6type regidx = int 6type regidx = int
7(*register value*)
8type regval = int 7type regval = int
9(*register*)
10type reg = Reg of regidx * regval 8type reg = Reg of regidx * regval
11(*URM instruction*) 9
12type urmcmd = 10type urmcmd =
13|Copy of regidx * regidx 11 | Copy of regidx * regidx
14|Jump of regidx * regidx * line 12 | Jump of regidx * regidx * line
15|Succ of regidx 13 | Succ of regidx
16|Zero of regidx 14 | Zero of regidx
17(*instruction pointer*) 15
18type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list 16type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list
19(*URM*) 17
20type urm = {instptr : instptr; regs : reg list} 18type urm = {
19 instptr : instptr;
20 regs : reg list
21}
21 22
22exception Syntax_error 23exception Syntax_error
23 24
24let rec string_of_file f = 25let rec string_of_file f =
25 try 26 try
26 let str = input_line f 27 let str = input_line f
27 in str ^ " " ^ (string_of_file f) 28 in str ^ " " ^ (string_of_file f)
28 with 29 with End_of_file -> ""
29 | End_of_file -> "" 30
30 31let rec program_of_lex = function
31let rec program_of_lex lex = 32 | [] -> []
32 match lex with 33 | "zero" :: arg_1 :: tail -> (Zero (int_of_string arg_1)) :: (program_of_lex tail)
33 |[] -> [] 34 | "succ" :: arg_1 :: tail -> (Succ (int_of_string arg_1)) :: (program_of_lex tail)
34 |"zero" :: arg_1 :: tail ->(Zero (int_of_string arg_1)) :: (program_of_lex tail) 35 | "copy" :: arg_1 :: arg_2 :: tail -> (Copy ((int_of_string arg_1), (int_of_string arg_2))) :: (program_of_lex tail)
35 |"succ" :: arg_1 :: tail -> (Succ (int_of_string arg_1)) :: (program_of_lex tail) 36 | "jump" :: arg_1 :: arg_2 :: arg_3 :: tail -> (Jump ((int_of_string arg_1), (int_of_string arg_2), (int_of_string arg_3))) :: (program_of_lex tail)
36 |"copy" :: arg_1 :: arg_2 :: tail -> (Copy ((int_of_string arg_1), (int_of_string arg_2))):: (program_of_lex tail) 37 | _ -> raise Syntax_error
37 |"jump" :: arg_1 :: arg_2 :: arg_3 :: tail ->(Jump ((int_of_string arg_1), (int_of_string arg_2),(int_of_string arg_3))):: (program_of_lex tail)
38 |_ -> raise Syntax_error
39 38
40let program_of_string str = 39let program_of_string str =
41 let lex = Str.split (Str.regexp "[\t\n(),]+") str 40 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 41 in List.iter (fun s -> print_string s; print_newline ()) lex; program_of_lex lex
43 42
44(*Creates a pointer of instruction from an urm command list*) 43(* Creates a pointer of instruction from an urm command list *)
45let instptr_mk urmcmd_list = 44let instptr_mk urmcmd_list =
46 let rec aux urmcmd_list count acc = 45 let rec aux urmcmd_list count acc =
47 match urmcmd_list with 46 match urmcmd_list with
48 | [] -> acc 47 | [] -> acc
49 | instruction::reste -> aux reste (count + 1) ((count,instruction)::acc) 48 | instr :: tail -> aux tail (count + 1) ((count, instr) :: acc)
50 in InstPtr([],rev (aux urmcmd_list 0 [])) 49 in InstPtr([], rev (aux urmcmd_list 0 []))
51 50
52(*Moves the pointer to the previous instruction*) 51(* Moves the pointer to the previous instruction *)
53let instptr_move_up = function 52let instptr_move_up = function
54 | InstPtr([],list2)-> InstPtr([],list2) 53 | InstPtr([], list2) -> InstPtr([], list2)
55 | InstPtr(instr::list1,list2) -> InstPtr(list1, instr::list2) 54 | InstPtr(instr :: list1, list2) -> InstPtr(list1, instr :: list2)
56 55
57(*Moves the pointer to the next instruction*) 56(* Moves the pointer to the next instruction *)
58let instptr_move_down = function 57let instptr_move_down = function
59 | InstPtr(list1,[])-> InstPtr(list1,[]) 58 | InstPtr(list1, []) -> InstPtr(list1, [])
60 | InstPtr(list1,instr::list2) -> InstPtr(instr::list1, list2) 59 | InstPtr(list1, instr :: list2) -> InstPtr(instr :: list1, list2)
61 60
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*) 61(* Returns the couple from the current pointer position : (line, instruction) where instruction is an urm command or fails if there is no instruction pointed *)
63let instptr_get = function 62let instptr_get = function
64 | InstPtr(list1,(l,Zero(a))::tail)-> (l,Zero(a)) 63 | InstPtr(list1, (l, Zero(a)) :: tail)-> (l, Zero(a))
65 | InstPtr(list1,(l,Succ(a))::tail) -> (l,Succ(a)) 64 | InstPtr(list1, (l, Succ(a)) :: tail) -> (l, Succ(a))
66 | InstPtr(list1,(l,Copy(a,b))::tail) -> (l,Copy(a,b)) 65 | InstPtr(list1, (l, Copy(a, b)) :: tail) -> (l, Copy(a, b))
67 | InstPtr(list1,(l,Jump(a,b,c))::tail) -> (l,Jump(a,b,c)) 66 | InstPtr(list1, (l, Jump(a, b, c)) :: tail) -> (l, Jump(a, b, c))
68 | InstPtr(_,[])-> failwith "No instruction left" 67 | InstPtr(_, [])-> failwith "No instruction left"
69 68
70(*Converts the current instruction pointed into a string (line and instruction formatted). If there is no instruction, returns "null"*) 69(* Converts the current instruction pointed into a string (line and instruction formatted). If there is no instruction, returns "null" *)
71let instptr_string instptr = 70let instptr_string instptr =
72 let aux = function 71 let aux = function
73 | l,Zero(a) -> (string_of_int l)^": Zero "^(string_of_int a) 72 | l, Zero(a) -> (string_of_int l) ^ ": Zero " ^ (string_of_int a)
74 | l,Succ(a) -> (string_of_int l)^": Succ "^(string_of_int a) 73 | l, Succ(a) -> (string_of_int l) ^ ": Succ " ^ (string_of_int a)
75 | l,Copy(a,b) -> (string_of_int l)^": Copy "^(string_of_int a)^" "^(string_of_int b) 74 | l, Copy(a, b) -> (string_of_int l) ^ ": Copy " ^ (string_of_int a) ^ " " ^ (string_of_int b)
76 | l,Jump(a,b,c) -> (string_of_int l)^": Jump "^(string_of_int a)^" "^(string_of_int b)^" "^(string_of_int c) 75 | l, Jump(a, b, c) -> (string_of_int l) ^ ": Jump " ^ (string_of_int a) ^ " " ^ (string_of_int b) ^ " " ^ (string_of_int c)
77 in try aux (instptr_get instptr) with 76 in try aux (instptr_get instptr) with _ -> "null"
78 | _ -> "null" 77
79 78(* Returns true if the instruction pointer is not pointing on any instruction (end of the instruction list) *)
80(*Returns true if the instruction pointer is not pointing on any instruction (end of the instruction list)*)
81let instptr_end = function 79let instptr_end = function
82 | InstPtr(_,[]) -> true 80 | InstPtr(_, []) -> true
83 | _ -> false 81 | _ -> false
84
85(*Returns the pointer of instruction after a jump decided by the given offset*)
86let rec instptr_jump ptr offset =
87if offset = 0 then ptr else
88 if offset > 0 then instptr_jump (instptr_move_up ptr) (offset-1)
89 else instptr_jump (instptr_move_down ptr) (offset+1)
90 82
83(* Returns the pointer of instruction after a jump decided by the given offse t*)
84let rec instptr_jump ptr offset = match offset with
85 | 0 -> ptr
86 | _ when offset > 0 -> instptr_jump (instptr_move_up ptr) (offset - 1)
87 | _ -> instptr_jump (instptr_move_down ptr) (offset + 1)
91 88
92let reg_idx (Reg(idx, _)) = idx 89let reg_idx (Reg(idx, _)) = idx
93
94let reg_val (Reg(_, value)) = value 90let reg_val (Reg(_, value)) = value
95 91
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.*) 92(* Compares two registers. Returns -1 if reg1 is lower than reg2, 1 if it is greater than reg2 or 0 if both are equals. *)
97let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2) 93let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2)
98 94
99(*Returns the value contained in the specified register in a register list*) 95(* Returns the value contained in the specified register in a register list *)
100let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x=idx) reglist |> reg_val 96let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x = idx) reglist |> reg_val
101 97
102(*Set the value of the register to value, or creates it to the value specified if it does not exist*) 98(* Set the value of the register to value, or creates it to the value specified if it does not exist *)
103let regs_set reglist index value = Reg(index,value)::(List.filter (fun (Reg(x,v))-> x!=index) reglist) 99let regs_set reglist index value = Reg(index, value) :: List.filter (fun (Reg(x, v)) -> x != index) reglist
104 100
105(*Gives a new urm by moving down its instruction pointer*) 101(* Gives a new urm by moving down its instruction pointer *)
106let urm_move_down urm = {instptr = (instptr_move_down urm.instptr); regs = urm.regs} 102let urm_move_down urm = { instptr = instptr_move_down urm.instptr ; regs = urm.regs }
107 103
104(* TODO: Verifier pour JUMP que a et b sont deux registres initialisés *)
108 105
109(*TODO: Verifier pour JUMP que a et b sont deux registres initialisés*) 106(* Applies the current instruction pointed by the pointer of instruction. Modifies the pointer of instruction for every instruction *)
110
111(*Applies the current instruction pointed by the pointer of instruction. Modifies the pointer of instruction for every instruction*)
112let urm_apply urm = 107let urm_apply urm =
113 let aux = function 108 let aux = function
114 | _,Zero(a) -> {instptr = urm.instptr ; regs = regs_set (urm.regs) a 0} |> urm_move_down 109 | _, Zero(a) -> { instptr = urm.instptr ; regs = regs_set (urm.regs) a 0 } |> urm_move_down
115 | _,Copy(a,b) when a!=b -> {instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b)} |> urm_move_down 110 | _, Copy(a, b) when a != b -> { instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b) } |> urm_move_down
116 | _,Copy(a,b) -> failwith "Copy from one register to itself" 111 | _, Copy(a, b) -> failwith "Copy from one register to itself"
117 | _,Succ(a) -> {instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a)+1)} |> urm_move_down 112 | _, Succ(a) -> { instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a) + 1) } |> urm_move_down
118 | _,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} 113 | _, 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 }
119 | _,_-> {instptr = urm.instptr; regs = urm.regs} |> urm_move_down 114 | _, _ -> { instptr = urm.instptr ; regs = urm.regs } |> urm_move_down
120 in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr) 115 in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr)
121 116
122(*Launches the URM*) 117(* Launches the URM *)
123let rec urm_run = function 118let rec urm_run = function
124 | {instptr = InstPtr(_,[]); regs = reg_list } -> reg_list 119 | { instptr = InstPtr(_, []) ; regs = reg_list } -> reg_list
125 | urm -> urm_apply urm |> urm_run 120 | urm -> urm_apply urm |> urm_run
121
122(* Creates an URM from a command list and a register list *)
123let urm_mk cmd_list reg_list = { instptr = (instptr_mk cmd_list) ; regs = reg_list }
126 124
127(*Creates an URM from a command list and a register list*)
128let urm_mk cmd_list reg_list = {instptr = (instptr_mk cmd_list) ; regs = reg_list}