diff options
-rw-r--r-- | common.mli | 27 | ||||
-rw-r--r-- | eurm.ml | 22 | ||||
-rw-r--r-- | eurml.mli | 25 | ||||
-rw-r--r-- | eurml_test.ml | 75 | ||||
-rw-r--r-- | makefile | 1 |
5 files changed, 148 insertions, 2 deletions
@@ -4,15 +4,35 @@ | |||
4 | *) | 4 | *) |
5 | 5 | ||
6 | type line = int | 6 | type line = int |
7 | type label = string | ||
7 | type regidx = int | 8 | type regidx = int |
8 | type regval = int | 9 | type regval = int |
9 | type reg = Reg of regidx * regval | 10 | type reg = Reg of regidx * regval |
10 | 11 | ||
11 | type urmcmd = | 12 | type urmcmd = |
13 | | URMCopy of regidx * regidx | ||
14 | | URMJump of regidx * regidx * line | ||
15 | | URMSucc of regidx | ||
16 | | URMZero of regidx | ||
17 | |||
18 | type eurmcmd = | ||
19 | | Add of regidx * regidx | ||
20 | | Comment of string | ||
12 | | Copy of regidx * regidx | 21 | | Copy of regidx * regidx |
13 | | Jump of regidx * regidx * line | 22 | | Dec of regidx |
14 | | Succ of regidx | 23 | | EqPredicate of regidx * regidx * label |
24 | | GEqPredicate of regidx * regidx * label | ||
25 | | GTPredicate of regidx * regidx * label | ||
26 | | Goto of label | ||
27 | | Inc of regidx | ||
28 | | Label of label | ||
29 | | LEqPredicate of regidx * regidx * label | ||
30 | | LTPredicate of regidx * regidx * label | ||
31 | | Mult of regidx * regidx | ||
32 | | Quit | ||
33 | | Sub of regidx * regidx | ||
15 | | Zero of regidx | 34 | | Zero of regidx |
35 | | ZeroPredicate of regidx * label | ||
16 | 36 | ||
17 | type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list | 37 | type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list |
18 | 38 | ||
@@ -21,4 +41,7 @@ type urm = { | |||
21 | regs : reg list | 41 | regs : reg list |
22 | } | 42 | } |
23 | 43 | ||
44 | type state = { todo : int } | ||
45 | |||
24 | exception Syntax_error | 46 | exception Syntax_error |
47 | |||
@@ -0,0 +1,22 @@ | |||
1 | (* | ||
2 | * UPEM / L3 / Functional programming / Project: URM | ||
3 | * Pacien TRAN-GIRARD, Adam NAILI | ||
4 | *) | ||
5 | |||
6 | open Common | ||
7 | |||
8 | let compile_preprocess eurmcmds = eurmcmds | ||
9 | let compile_stage1 eurmcmds state = eurmcmds, state | ||
10 | let compile_stage2 eurmcmds state = eurmcmds, state | ||
11 | let compile_stage3 eurmcmds state = eurmcmds, state | ||
12 | let compile_stage4 eurmcmds state = [URMZero(0)], state | ||
13 | |||
14 | let urm_from_eurm = | ||
15 | let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state | ||
16 | and initial_state = 0 | ||
17 | in (compile_preprocess, initial_state) | ||
18 | |> chain compile_stage1 | ||
19 | |> chain compile_stage2 | ||
20 | |> chain compile_stage3 | ||
21 | |> chain compile_stage4 | ||
22 | |||
diff --git a/eurml.mli b/eurml.mli new file mode 100644 index 0000000..8fd8ef1 --- /dev/null +++ b/eurml.mli | |||
@@ -0,0 +1,25 @@ | |||
1 | (* | ||
2 | * UPEM / L3 / Functional programming / Project: URM | ||
3 | * Pacien TRAN-GIRARD, Adam NAILI | ||
4 | *) | ||
5 | |||
6 | open Common | ||
7 | |||
8 | (* Strips out comments and rewrite/enumerate labels *) | ||
9 | val compile_preprocess : eurmcmd list -> eurmcmd list | ||
10 | |||
11 | (* Rewrites Dec, GEqPredicate, LEqPredicate, LTPredicate, Mult and ZeroPredicate *) | ||
12 | val compile_stage1 : eurmcmd list -> state -> eurmcmd list * state | ||
13 | |||
14 | (* Rewrites Add, GTPredicate and Sub *) | ||
15 | val compile_stage2 : eurmcmd list -> state -> eurmcmd list * state | ||
16 | |||
17 | (* Rewrites Goto *) | ||
18 | val compile_stage3 : eurmcmd list -> state -> eurmcmd list * state | ||
19 | |||
20 | (* Rewrites Inc, EqPredicate, Label and Zero *) | ||
21 | val compile_stage4 : eurmcmd list -> state -> urmcmd list * state | ||
22 | |||
23 | (* Transcompiles an EURM instruction sequence into URM *) | ||
24 | val urm_from_eurm : eurmcmd list -> urmcmd list | ||
25 | |||
diff --git a/eurml_test.ml b/eurml_test.ml new file mode 100644 index 0000000..7dc6e5e --- /dev/null +++ b/eurml_test.ml | |||
@@ -0,0 +1,75 @@ | |||
1 | (* | ||
2 | * UPEM / L3 / Functional programming / Project: URM | ||
3 | * Pacien TRAN-GIRARD, Adam NAILI | ||
4 | *) | ||
5 | |||
6 | open Common | ||
7 | open Urm | ||
8 | open Eurm | ||
9 | open Kaputt.Abbreviations | ||
10 | |||
11 | let () = | ||
12 | Test.add_simple_test | ||
13 | ~title:"example_eurm_factorial_conversion" | ||
14 | (fun () -> | ||
15 | let input_eurm = [ | ||
16 | Comment "Compute r1! and place the result in r1"; | ||
17 | ZeroPredicate (1, "r1=0"); | ||
18 | Goto "r1>0"; | ||
19 | Comment "r1 holds 0"; | ||
20 | Label "r1=0"; | ||
21 | Inc 1; | ||
22 | Goto "done"; | ||
23 | Comment "r1 holds a positive integer"; | ||
24 | Label "r1>0"; | ||
25 | Copy (2, 1); | ||
26 | Zero 1; | ||
27 | Inc 1; | ||
28 | Zero 3; | ||
29 | Inc 3; | ||
30 | Comment "main loop"; | ||
31 | Label "loop"; | ||
32 | Mult (1, 3); | ||
33 | EqPredicate (2, 3, "done"); | ||
34 | Inc 3; | ||
35 | Goto "loop"; | ||
36 | Label "done"; | ||
37 | Quit] | ||
38 | and expected_urm = [ | ||
39 | URMZero 4; | ||
40 | URMJump (1, 4, 4); | ||
41 | URMZero 8; | ||
42 | URMJump (8, 8, 7); | ||
43 | URMSucc 1; | ||
44 | URMZero 9; | ||
45 | URMJump (9, 9, 29); | ||
46 | URMCopy (2, 1); | ||
47 | URMZero 1; | ||
48 | URMSucc 1; | ||
49 | URMZero 3; | ||
50 | URMSucc 3; | ||
51 | URMCopy (5, 1); | ||
52 | URMZero 1; | ||
53 | URMZero 6; | ||
54 | URMJump (3, 6, 25); | ||
55 | URMZero 7; | ||
56 | URMJump (5, 7, 22); | ||
57 | URMSucc 1; | ||
58 | URMSucc 7; | ||
59 | URMZero 10; | ||
60 | URMJump (10, 10, 17); | ||
61 | URMSucc 6; | ||
62 | URMZero 11; | ||
63 | URMJump (11, 11, 15); | ||
64 | URMJump (2, 3, 29); | ||
65 | URMSucc 3; | ||
66 | URMZero 12; | ||
67 | URMJump (12, 12, 12); | ||
68 | URMZero 13; | ||
69 | URMJump (13, 13, 38)] | ||
70 | in let output_urm = urm_from_eurm input_eurm | ||
71 | in | ||
72 | Assert.is_true (output_urm = expected_urm)) | ||
73 | |||
74 | let () = if Array.mem "run-tests" Sys.argv then Test.launch_tests () | ||
75 | |||
@@ -7,6 +7,7 @@ SOURCES = \ | |||
7 | instptr.mli instptr.ml \ | 7 | instptr.mli instptr.ml \ |
8 | reg.mli reg.ml \ | 8 | reg.mli reg.ml \ |
9 | urm.mli urm.ml urm_test.ml \ | 9 | urm.mli urm.ml urm_test.ml \ |
10 | eurm.mli eurm.ml eurm_test.ml \ | ||
10 | main.ml | 11 | main.ml |
11 | 12 | ||
12 | OCAMLMAKEFILE = /usr/share/ocamlmakefile/OCamlMakefile | 13 | OCAMLMAKEFILE = /usr/share/ocamlmakefile/OCamlMakefile |