summaryrefslogtreecommitdiff
path: root/optimize.ml
blob: a0bee21ee4cf8e53b744d70714d1200ab6a4a7d5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
(****************************************
    optimize.ml - optimisations de code
 ****************************************)

open Ast
open Utils
open Mips

(* Réduit les opérations constantes précalculables de l'ast *)
let optimize_binop e1 o e2 =
    match e1.e, o, e2.e with
        | (Econst (Cint c1), OAdd, Econst (Cint c2)) ->
            Econst (Cint (c1 + c2))
        | (Econst (Cint c1), OSub, Econst (Cint c2)) ->
            Econst (Cint (c1 - c2))
        | (Econst (Cint c1), OMul, Econst (Cint c2)) ->
            Econst (Cint (c1 * c2))
        | (Econst (Cint c1), ODiv, Econst (Cint c2)) ->
            Econst (Cint (c1 / c2))
        | (Econst (Cint c1), OEq, Econst (Cint c2)) ->
            Econst (Cbool (c1 = c2))
        | (Econst (Cint c1), ONeq, Econst (Cint c2)) ->
            Econst (Cbool (c1 <> c2))
        | (Econst (Cint c1), OLt, Econst (Cint c2)) ->
            Econst (Cbool (c1 < c2))
        | (Econst (Cint c1), OLe, Econst (Cint c2)) ->
            Econst (Cbool (c1 <= c2))
        | (Econst (Cint c1), OGt, Econst (Cint c2)) ->
            Econst (Cbool (c1 > c2))
        | (Econst (Cint c1), OGe, Econst (Cint c2)) ->
            Econst (Cbool (c1 >= c2))
        | (Econst (Cbool c1), OAnd, Econst (Cbool c2)) ->
            Econst (Cbool (c1 && c2))
        | (Econst (Cbool true), OAnd, e)
        | (e, OAnd, Econst (Cbool true)) ->
            e
        | (Econst (Cbool false), OAnd, e)
        | (e, OAnd, Econst (Cbool false)) ->
            Econst (Cbool false)
        | (Econst (Cbool c1), OOr, Econst (Cbool c2)) ->
            Econst (Cbool (c1 || c2))
        | (Econst (Cbool true), OOr, e)
        | (e, OOr, Econst (Cbool true)) ->
            Econst (Cbool true)
        | (Econst (Cbool false), OOr, e)
        | (e, OOr, Econst (Cbool false)) ->
            e
        | _ ->
            Ebinop (e1, o, e2)

let optimize_unop o e =
    match o, e.e with
        | (ONeg, Econst (Cint c)) ->
            Econst (Cint (-c))
        | (ONot, Econst (Cbool b)) ->
            Econst (Cbool (not b))
        | _ ->
            Eunop (o, e)

let optimize_if cond_expr then_expr else_expr =
    match cond_expr.e with
        | Econst (Cbool true) -> then_expr.e
        | Econst (Cbool false) -> else_expr.e
        | _ -> Eif (cond_expr, then_expr, else_expr) 

let optimize_match match_expr empty_expr head_m tail_m result_expr =
    match match_expr.e with
        | Econst (Cemptylist) -> empty_expr.e
        | _ -> Ematch (match_expr, empty_expr, head_m, tail_m, result_expr) 

let rec optimize_ast expr =
    let new_e =
        match expr.e with
            | Econst _ -> expr.e
            | Eident _ -> expr.e
            | Etuple l ->
                Etuple (List.map optimize_ast l)
            | Ebinop (e1, o, e2) ->
                optimize_binop (optimize_ast e1) o (optimize_ast e2)
            | Eunop (o, e) ->
                optimize_unop o (optimize_ast e)
            | Eletin (m, val_expr, in_expr) ->
                Eletin (m, optimize_ast val_expr, optimize_ast in_expr)
            | Efunc f ->
                Efunc {f with body = optimize_ast f.body}
            | Eif (cond_expr, then_expr, else_expr) ->
                optimize_if (optimize_ast cond_expr)
                            (optimize_ast then_expr)
                            (optimize_ast else_expr)
            | Elistcons (e1, e2) ->
                Elistcons (optimize_ast e1, optimize_ast e2)
            | Ecall (e1, e2) ->
                Ecall (optimize_ast e1, optimize_ast e2)
            | Ematch (match_expr, empty_expr, head_m, tail_m, result_expr) ->
                Ematch (optimize_ast match_expr,
                        optimize_ast empty_expr,
                        head_m,
                        tail_m,
                        optimize_ast result_expr)
            | Eclos _ -> failwith "optimize_ast : Unreachable matching"
    in
        raw_expr new_e

(* Réduction des opérations assembleur consécutives *)
(* TODO : optimiser plus *)
let optimize_program p =
    let rec optimize_instrs = function
        | [] -> []
        | (Addi (rdest1, rsrc1, i1))::(Addi (rdest2, rsrc2, i2))::l
           when rdest1 = rdest2 && rsrc1 = rsrc2 ->
            optimize_instrs ((Addi (rdest1, rsrc1, i1 + i2))::l)
        | i::l -> i::(optimize_instrs l)
    in
        {p with text = optimize_instrs p.text}