diff options
Diffstat (limited to 'projet.ml')
-rw-r--r-- | projet.ml | 17 |
1 files changed, 16 insertions, 1 deletions
@@ -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*) | ||
44 | let instptr_mk urmcmd_list = | 45 | let 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*) | ||
51 | let instptr_move_up = function | 53 | let 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*) | ||
55 | let instptr_move_down = function | 58 | let 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*) | ||
59 | let instptr_get = function | 63 | let 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"*) | ||
66 | let instptr_string instptr = | 71 | let 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)*) | ||
75 | let instptr_end = function | 81 | let 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*) |
80 | let rec instptr_jump ptr offset = | 86 | let rec instptr_jump ptr offset = |
81 | if offset = 0 then ptr else | 87 | if 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 | ||
88 | let reg_val (Reg(_, value)) = value | 94 | let 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.*) | ||
90 | let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2) | 97 | let 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*) | ||
92 | let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x=idx) reglist |> reg_val | 100 | let 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*) | ||
94 | let regs_set reglist index value = Reg(index,value)::(List.filter (fun (Reg(x,v))-> x!=index) reglist) | 103 | let 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*) | ||
96 | let urm_move_down urm = {instptr = (instptr_move_down urm.instptr); regs = urm.regs} | 106 | let 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*) | ||
99 | let urm_apply urm = | 112 | let 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*) | ||
109 | let rec urm_run = function | 123 | let 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*) | ||
113 | let urm_mk cmd_list reg_list = {instptr = (instptr_mk cmd_list) ; regs = reg_list} | 128 | let urm_mk cmd_list reg_list = {instptr = (instptr_mk cmd_list) ; regs = reg_list} |