diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/eurm_test.ml | 2 | ||||
-rw-r--r-- | src/main.ml | 12 | ||||
-rw-r--r-- | src/parser.ml | 47 | ||||
-rw-r--r-- | src/parser.mli | 9 |
4 files changed, 54 insertions, 16 deletions
diff --git a/src/eurm_test.ml b/src/eurm_test.ml index afecf9e..a3ef5a8 100644 --- a/src/eurm_test.ml +++ b/src/eurm_test.ml | |||
@@ -8,6 +8,7 @@ open Urm | |||
8 | open Eurm | 8 | open Eurm |
9 | open Kaputt.Abbreviations | 9 | open Kaputt.Abbreviations |
10 | 10 | ||
11 | (* | ||
11 | let () = | 12 | let () = |
12 | Test.add_simple_test | 13 | Test.add_simple_test |
13 | ~title:"example_eurm_factorial_conversion" | 14 | ~title:"example_eurm_factorial_conversion" |
@@ -72,3 +73,4 @@ let () = | |||
72 | Assert.is_true (output_urm = expected_urm)) | 73 | Assert.is_true (output_urm = expected_urm)) |
73 | 74 | ||
74 | let () = if Array.mem "run-tests" Sys.argv then Test.launch_tests () | 75 | let () = if Array.mem "run-tests" Sys.argv then Test.launch_tests () |
76 | *) | ||
diff --git a/src/main.ml b/src/main.ml index 3e66645..c6a059e 100644 --- a/src/main.ml +++ b/src/main.ml | |||
@@ -8,13 +8,14 @@ open Parser | |||
8 | open Instptr | 8 | open Instptr |
9 | open Reg | 9 | open Reg |
10 | open Urm | 10 | open Urm |
11 | open Eurm | ||
11 | 12 | ||
12 | let exec_with_resource func filename = | 13 | let exec_with_resource func filename = |
13 | let file = open_in filename in | 14 | let file = open_in filename in |
14 | let res = func file in | 15 | let res = func file in |
15 | close_in file; res | 16 | close_in file; res |
16 | 17 | ||
17 | let read_prgm = exec_with_resource (fun f -> string_of_file f |> program_of_string) | 18 | let read_prgm lexer = exec_with_resource (fun f -> string_of_file f |> program_of_string lexer) |
18 | let read_regs = exec_with_resource (fun f -> string_of_file f |> regs_of_string) | 19 | let read_regs = exec_with_resource (fun f -> string_of_file f |> regs_of_string) |
19 | let run run_func prgm regs = urm_mk prgm regs |> run_func |> regs_string |> print_endline | 20 | let run run_func prgm regs = urm_mk prgm regs |> run_func |> regs_string |> print_endline |
20 | 21 | ||
@@ -23,7 +24,12 @@ let run_mode_of_string = function | |||
23 | | "trace" -> urm_run_trace | 24 | | "trace" -> urm_run_trace |
24 | | _ -> failwith "Invalid run mode" | 25 | | _ -> failwith "Invalid run mode" |
25 | 26 | ||
27 | let lexer_of_string = function | ||
28 | | "urm" -> (urm_program_of_lex) | ||
29 | | "eurm" -> (fun toks -> eurm_program_of_lex toks |> urm_from_eurm) | ||
30 | | _ -> failwith "Invalid lang" | ||
31 | |||
26 | let () = match Sys.argv with | 32 | let () = match Sys.argv with |
27 | | [| _; "run-tests" |] -> () (* handled in test files *) | 33 | | [| _; "run-tests" |] -> () (* handled in test files *) |
28 | | [| _; mode; prgm; regs |] -> run (run_mode_of_string mode) (read_prgm prgm) (read_regs regs) | 34 | | [| _; mode; lang; prgm; regs |] -> run (run_mode_of_string mode) (read_prgm (lexer_of_string lang) prgm) (read_regs regs) |
29 | | _ -> print_endline "Usage: urm <run-tests | run <prgmfile> <regfile> | trace <prgmfile> <regfile>>" | 35 | | _ -> print_endline "Usage: urm <run | trace> <urm | eurm> <prgmfile> <regfile>" |
diff --git a/src/parser.ml b/src/parser.ml index 0bc1be6..0a0c3a8 100644 --- a/src/parser.ml +++ b/src/parser.ml | |||
@@ -8,24 +8,51 @@ open Common | |||
8 | let rec string_of_file f = | 8 | let rec string_of_file f = |
9 | try | 9 | try |
10 | let str = input_line f | 10 | let str = input_line f |
11 | in str ^ " " ^ (string_of_file f) | 11 | in str ^ "\n" ^ (string_of_file f) |
12 | with End_of_file -> "" | 12 | with End_of_file -> "" |
13 | 13 | ||
14 | let rec program_of_lex = function | 14 | let rec eurm_program_of_lex = function |
15 | | [] -> [] | 15 | | [] -> [] |
16 | | instr :: tail -> match (String.lowercase_ascii instr) :: tail with | 16 | | l -> match l with |
17 | | "zero" :: arg_1 :: tail -> (URMZero (int_of_string arg_1)) :: (program_of_lex tail) | 17 | | "comment" :: comment :: tail -> Comment(comment) :: eurm_program_of_lex tail |
18 | | "succ" :: arg_1 :: tail -> (URMSucc (int_of_string arg_1)) :: (program_of_lex tail) | 18 | | "label" :: lbl :: tail -> Label(lbl) :: eurm_program_of_lex tail |
19 | | "copy" :: arg_1 :: arg_2 :: tail -> (URMCopy ((int_of_string arg_1), (int_of_string arg_2))) :: (program_of_lex tail) | 19 | | "goto" :: lbl :: tail -> Goto(lbl) :: eurm_program_of_lex tail |
20 | | "jump" :: arg_1 :: arg_2 :: arg_3 :: tail -> (URMJump ((int_of_string arg_1), (int_of_string arg_2), (int_of_string arg_3))) :: (program_of_lex tail) | 20 | | "zero" :: r :: tail -> Zero(int_of_string r) :: eurm_program_of_lex tail |
21 | | "inc" :: r :: tail -> Inc(int_of_string r) :: eurm_program_of_lex tail | ||
22 | | "dec" :: r :: tail -> Dec(int_of_string r) :: eurm_program_of_lex tail | ||
23 | | "copy" :: r1 :: r2 :: tail -> Copy(int_of_string r1, int_of_string r2) :: eurm_program_of_lex tail | ||
24 | | "add" :: r1 :: r2 :: tail -> Add(int_of_string r1, int_of_string r2) :: eurm_program_of_lex tail | ||
25 | | "sub" :: r1 :: r2 :: tail -> Sub(int_of_string r1, int_of_string r2) :: eurm_program_of_lex tail | ||
26 | | "mult" :: r1 :: r2 :: tail -> Mult(int_of_string r1, int_of_string r2) :: eurm_program_of_lex tail | ||
27 | | "eq?" :: r1 :: r2 :: lbl :: tail -> EqPredicate(int_of_string r1, int_of_string r2, lbl) :: eurm_program_of_lex tail | ||
28 | | "geq?" :: r1 :: r2 :: lbl :: tail -> GEqPredicate(int_of_string r1, int_of_string r2, lbl) :: eurm_program_of_lex tail | ||
29 | | "gt?" :: r1 :: r2 :: lbl :: tail -> GTPredicate(int_of_string r1, int_of_string r2, lbl) :: eurm_program_of_lex tail | ||
30 | | "leq?" :: r1 :: r2 :: lbl :: tail -> LEqPredicate(int_of_string r1, int_of_string r2, lbl) :: eurm_program_of_lex tail | ||
31 | | "lt?" :: r1 :: r2 :: lbl :: tail -> LTPredicate(int_of_string r1, int_of_string r2, lbl) :: eurm_program_of_lex tail | ||
32 | | "zero?" :: r :: lbl :: tail -> ZeroPredicate(int_of_string r, lbl) :: eurm_program_of_lex tail | ||
33 | | "quit" :: tail -> Quit :: eurm_program_of_lex tail | ||
34 | | x -> String.concat " " x |> print_endline; raise Syntax_error | ||
35 | |||
36 | let rec urm_program_of_lex = function | ||
37 | | [] -> [] | ||
38 | | l -> match l with | ||
39 | | "zero" :: r :: tail -> URMZero(int_of_string r) :: urm_program_of_lex tail | ||
40 | | "succ" :: r :: tail -> URMSucc(int_of_string r) :: urm_program_of_lex tail | ||
41 | | "copy" :: r1 :: r2 :: tail -> URMCopy(int_of_string r1, int_of_string r2) :: urm_program_of_lex tail | ||
42 | | "jump" :: r1 :: r2 :: l :: tail -> URMJump (int_of_string r1, int_of_string r2, int_of_string l) :: urm_program_of_lex tail | ||
21 | | _ -> raise Syntax_error | 43 | | _ -> raise Syntax_error |
22 | 44 | ||
23 | (* FIXME: reject multiple definition of a single register *) | 45 | (* TODO: reject multiple definition of a single register *) |
24 | let rec regs_of_lex = function | 46 | let rec regs_of_lex = function |
25 | | [] -> [] | 47 | | [] -> [] |
26 | | regnum :: regvalue :: tail -> Reg (int_of_string regnum, int_of_string regvalue) :: (regs_of_lex tail) | 48 | | regnum :: regvalue :: tail -> Reg (int_of_string regnum, int_of_string regvalue) :: (regs_of_lex tail) |
27 | | _ -> raise Syntax_error | 49 | | _ -> raise Syntax_error |
28 | 50 | ||
29 | let seq_from_string lexer_func str = Str.split (Str.regexp "[\t\n(), ]+") str |> lexer_func | 51 | let seq_from_string lexer_func str = |
30 | let program_of_string = seq_from_string program_of_lex | 52 | String.lowercase_ascii str |
53 | |> Str.global_replace (Str.regexp "comment.*\n") "" | ||
54 | |> Str.split (Str.regexp "[\t\n(), ]+") | ||
55 | |> lexer_func | ||
56 | |||
57 | let program_of_string lexer = seq_from_string lexer | ||
31 | let regs_of_string = seq_from_string regs_of_lex | 58 | let regs_of_string = seq_from_string regs_of_lex |
diff --git a/src/parser.mli b/src/parser.mli index 21fc940..2cad383 100644 --- a/src/parser.mli +++ b/src/parser.mli | |||
@@ -8,14 +8,17 @@ open Common | |||
8 | (* Reads a file into a string. *) | 8 | (* Reads a file into a string. *) |
9 | val string_of_file : in_channel -> string | 9 | val string_of_file : in_channel -> string |
10 | 10 | ||
11 | (* Converts lexemes into instructions. *) | 11 | (* Converts lexemes into URM instructions. *) |
12 | val program_of_lex : string list -> urmcmd list | 12 | val urm_program_of_lex : string list -> urmcmd list |
13 | |||
14 | (* Converts lexemes into EURM instructions. *) | ||
15 | val eurm_program_of_lex : string list -> eurmcmd list | ||
13 | 16 | ||
14 | (* Converts lexemes into registers. *) | 17 | (* Converts lexemes into registers. *) |
15 | val regs_of_lex : string list -> reg list | 18 | val regs_of_lex : string list -> reg list |
16 | 19 | ||
17 | (* Parses the string representation of a program. *) | 20 | (* Parses the string representation of a program. *) |
18 | val program_of_string : string -> urmcmd list | 21 | val program_of_string : (string list -> 'a list) -> string -> 'a list |
19 | 22 | ||
20 | (* Parses the string representation of serialized registers. *) | 23 | (* Parses the string representation of serialized registers. *) |
21 | val regs_of_string : string -> reg list | 24 | val regs_of_string : string -> reg list |