diff options
-rw-r--r-- | projet.ml | 176 |
1 files changed, 86 insertions, 90 deletions
@@ -1,128 +1,124 @@ | |||
1 | #load "str.cma";; | 1 | #load "str.cma";; |
2 | open List;; | 2 | |
3 | (*line number*) | 3 | open List |
4 | |||
4 | type line = int | 5 | type line = int |
5 | (*register index*) | ||
6 | type regidx = int | 6 | type regidx = int |
7 | (*register value*) | ||
8 | type regval = int | 7 | type regval = int |
9 | (*register*) | ||
10 | type reg = Reg of regidx * regval | 8 | type reg = Reg of regidx * regval |
11 | (*URM instruction*) | 9 | |
12 | type urmcmd = | 10 | type 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 | |
18 | type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list | 16 | type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list |
19 | (*URM*) | 17 | |
20 | type urm = {instptr : instptr; regs : reg list} | 18 | type urm = { |
19 | instptr : instptr; | ||
20 | regs : reg list | ||
21 | } | ||
21 | 22 | ||
22 | exception Syntax_error | 23 | exception Syntax_error |
23 | 24 | ||
24 | let rec string_of_file f = | 25 | let 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 | 31 | let rec program_of_lex = function | |
31 | let 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 | ||
40 | let program_of_string str = | 39 | let 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 *) |
45 | let instptr_mk urmcmd_list = | 44 | let 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 *) |
53 | let instptr_move_up = function | 52 | let 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 *) |
58 | let instptr_move_down = function | 57 | let 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 *) |
63 | let instptr_get = function | 62 | let 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" *) |
71 | let instptr_string instptr = | 70 | let 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)*) | ||
81 | let instptr_end = function | 79 | let 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*) | ||
86 | let rec instptr_jump ptr offset = | ||
87 | if 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*) | ||
84 | let 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 | ||
92 | let reg_idx (Reg(idx, _)) = idx | 89 | let reg_idx (Reg(idx, _)) = idx |
93 | |||
94 | let reg_val (Reg(_, value)) = value | 90 | let 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. *) |
97 | let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2) | 93 | let 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 *) |
100 | let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x=idx) reglist |> reg_val | 96 | let 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 *) |
103 | let regs_set reglist index value = Reg(index,value)::(List.filter (fun (Reg(x,v))-> x!=index) reglist) | 99 | let 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 *) |
106 | let urm_move_down urm = {instptr = (instptr_move_down urm.instptr); regs = urm.regs} | 102 | let 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*) | ||
112 | let urm_apply urm = | 107 | let 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 *) |
123 | let rec urm_run = function | 118 | let 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 *) | ||
123 | let 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*) | ||
128 | let urm_mk cmd_list reg_list = {instptr = (instptr_mk cmd_list) ; regs = reg_list} | ||