elang_run.ml 6.6 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
open Elang
open Batteries
open BatList
open Prog
open Utils
open Builtins
open Utils

let binop_bool_to_int f x y = if f x y then 1 else 0

(* [eval_binop b x y] évalue l'opération binaire [b] sur les arguments [x]
   et [y]. *)
let eval_binop (b: binop) : int -> int -> int =
  match b with
Armillon Damien's avatar
Armillon Damien committed
15
16
17
18
19
20
21
22
23
24
25
26
   | Eadd -> fun x y -> x + y
   | Esub -> fun x y -> x - y
   | Emul -> fun x y -> x * y
   | Ediv -> fun x y -> x / y
   | Emod -> fun x y -> (x mod y)
   | Exor -> fun x y -> x lxor y
   | Eclt -> fun x y -> binop_bool_to_int (<) x y
   | Ecle -> fun x y -> binop_bool_to_int (<=) x y
   | Ecgt -> fun x y -> binop_bool_to_int (>) x y
   | Ecge -> fun x y -> binop_bool_to_int (>=) x y
   | Eceq -> fun x y -> binop_bool_to_int (=) x y
   | Ecne -> fun x y -> binop_bool_to_int (!=) x y
27
28
29
30

(* [eval_unop u x] évalue l'opération unaire [u] sur l'argument [x]. *)
let eval_unop (u: unop) : int -> int =
  match u with
Armillon Damien's avatar
Armillon Damien committed
31
   | Eneg -> fun x -> -x
32

Armillon Damien's avatar
Armillon Damien committed
33
(* [eval_eexpr oc ep st e] évalue l'expression [e] dans l'état [st]. Renvoie une
34
   erreur si besoin. *)
Armillon Damien's avatar
Armillon Damien committed
35
let rec eval_eexpr oc (ep: eprog) st (e : expr) : (int * int Prog.state) res =
Armillon Damien's avatar
Armillon Damien committed
36
37
   match e with
   | Ebinop(op,expr1,expr2) ->
Armillon Damien's avatar
Armillon Damien committed
38
39
40
41
42
43
44
45
      let* (value1, st) = eval_eexpr oc ep st expr1 in
      let* (value2, st) = eval_eexpr oc ep st expr2 in
          OK((eval_binop op value1 value2), st)

   | Eunop(op,expr) ->
      let* (value,st) = eval_eexpr oc ep st expr in
      OK((eval_unop op value), st)

Armillon Damien's avatar
Armillon Damien committed
46
   | Evar(str) ->
Armillon Damien's avatar
Armillon Damien committed
47
      (match Hashtbl.find_option st.env str with 
Armillon Damien's avatar
Armillon Damien committed
48
      | None -> Error (Format.sprintf "Unknown variable %s\n" str)
Armillon Damien's avatar
Armillon Damien committed
49
50
51
52
53
54
55
56
57
58
59
60
61
      | Some(name) -> OK(name, st))
   | Eint(n) -> OK(n, st)
   | Ecall(name,expr_list) ->
      let* (args, st) = List.fold_left (fun acc expr ->
         let* (expr_l, st) = acc in
         let* (arg_expr, st) = eval_eexpr oc ep st expr in
         OK(expr_l@[arg_expr], st)
         ) (OK([], st)) expr_list in 
      let* f = find_function ep name in
      let* (res,st) = eval_efun oc ep st f name args in
      match res with
      | Some(n) -> OK(n, st)
      | None -> Error (Format.sprintf "Error with function %s" name)
62

63
(* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
64

65
66
   Le paramètre [oc] est un "output channel", dans lequel la fonction "print"
   écrit sa sortie, au moyen de l'instruction [Format.fprintf].
67

68
   Cette fonction renvoie [(ret, st')] :
69

70
71
72
   - [ret] est de type [int option]. [Some v] doit être renvoyé lorsqu'une
   instruction [return] est évaluée. [None] signifie qu'aucun [return] n'a eu
   lieu et que l'exécution doit continuer.
73

74
   - [st'] est l'état mis à jour. *)
Armillon Damien's avatar
Armillon Damien committed
75
and eval_einstr oc (ep: eprog) (st: int state) (ins: instr) :
76
  (int option * int state) res =
Armillon Damien's avatar
Armillon Damien committed
77
78
79
  let rec eval_list_instrs st li : (int option * int state) res =
   match li with 
   | [] -> OK(None,st)
Armillon Damien's avatar
Armillon Damien committed
80
   | instr::next_instrs -> eval_einstr oc ep st instr >>= fun result ->
Armillon Damien's avatar
Armillon Damien committed
81
82
83
84
85
       match result with
       | (None, st) -> eval_list_instrs st next_instrs
       | (Some(n), st) -> OK(result)
 in
 let rec eval_while st e i: (int option * int state) res =
Armillon Damien's avatar
Armillon Damien committed
86
87
88
   let* (condition,st) = eval_eexpr oc ep st e in
      if condition = 1 then 
         eval_einstr oc ep st i >>= fun result_loop ->
Armillon Damien's avatar
Armillon Damien committed
89
90
91
92
93
94
         match result_loop with
         | (None, st)-> (eval_while st e i)
         | (Some(n), st) -> OK(result_loop)
      else OK(None, st)
  in 
   match ins with
Armillon Damien's avatar
Armillon Damien committed
95
96
97
98
99
100
101
102
103
   | Iassign(str, expr) ->
      let* (value, st) = eval_eexpr oc ep st expr in
      Hashtbl.replace st.env str value;
      OK(None,st)

   | Iif(expr,instr1,instr2) ->
      let* (condition,st) = eval_eexpr oc ep st expr in
        if condition=1 then eval_einstr oc ep st instr1 else eval_einstr oc ep st instr2
   
Armillon Damien's avatar
Armillon Damien committed
104
   | Iwhile(expr,instr) -> eval_while st expr instr
Armillon Damien's avatar
Armillon Damien committed
105

Armillon Damien's avatar
Armillon Damien committed
106
   | Iblock(instrs) -> eval_list_instrs st instrs
Armillon Damien's avatar
Armillon Damien committed
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

   | Ireturn(expr) ->
      let* (result,st) = eval_eexpr oc ep st expr
      in OK(Some(result), st)

   | Iprint(expr) ->
      let* (result, st) = eval_eexpr oc ep st expr in
      Format.fprintf oc "%d\n" result; OK(None, st)
   
   | Icall(name,expr_list) ->
      let* (args, st) = List.fold_left (fun acc expr ->
         let* (expr_l, st) = acc in
         let* (arg_expr, st) = eval_eexpr oc ep st expr in
         OK(expr_l@[arg_expr], st)
         ) (OK([], st)) expr_list in
      let* f = find_function ep name in
      eval_efun oc ep st f name args

125

126
127
(* [eval_efun oc st f fname vargs] évalue la fonction [f] (dont le nom est
   [fname]) en partant de l'état [st], avec les arguments [vargs].
128

129
130
   Cette fonction renvoie un couple (ret, st') avec la même signification que
   pour [eval_einstr]. *)
Armillon Damien's avatar
Armillon Damien committed
131
and eval_efun oc (ep: eprog) (st: int state) ({ funargs; funbody}: efun)
132
133
    (fname: string) (vargs: int list)
  : (int option * int state) res =
134
135
136
137
138
  (* L'environnement d'une fonction (mapping des variables locales vers leurs
     valeurs) est local et un appel de fonction ne devrait pas modifier les
     variables de l'appelant. Donc, on sauvegarde l'environnement de l'appelant
     dans [env_save], on appelle la fonction dans un environnement propre (Avec
     seulement ses arguments), puis on restore l'environnement de l'appelant. *)
139
140
141
142
  let env_save = Hashtbl.copy st.env in
  let env = Hashtbl.create 17 in
  match List.iter2 (fun a v -> Hashtbl.replace env a v) funargs vargs with
  | () ->
Armillon Damien's avatar
Armillon Damien committed
143
    eval_einstr oc ep { st with env } funbody >>= fun (v, st') ->
144
145
146
147
148
149
150
    OK (v, { st' with env = env_save })
  | exception Invalid_argument _ ->
    Error (Format.sprintf
             "E: Called function %s with %d arguments, expected %d.\n"
             fname (List.length vargs) (List.length funargs)
          )

151
(* [eval_eprog oc ep memsize params] évalue un programme complet [ep], avec les
152
153
   arguments [params].

154
155
156
157
   Le paramètre [memsize] donne la taille de la mémoire dont ce programme va
   disposer. Ce n'est pas utile tout de suite (nos programmes n'utilisent pas de
   mémoire), mais ça le sera lorsqu'on ajoutera de l'allocation dynamique dans
   nos programmes.
158

159
160
161
162
163
164
165
166
   Renvoie:

   - [OK (Some v)] lorsque l'évaluation de la fonction a lieu sans problèmes et renvoie une valeur [v].

   - [OK None] lorsque l'évaluation de la fonction termine sans renvoyer de valeur.

   - [Error msg] lorsqu'une erreur survient.
   *)
167
168
169
170
let eval_eprog oc (ep: eprog) (memsize: int) (params: int list)
  : int option res =
  let st = init_state memsize in
  find_function ep "main" >>= fun f ->
171
  (* ne garde que le nombre nécessaire de paramètres pour la fonction "main". *)
172
173
  let n = List.length f.funargs in
  let params = take n params in
Armillon Damien's avatar
Armillon Damien committed
174
175
176
  let { env } = st in
  let { funargs } = f in
  List.iter2 (fun argname argval -> Hashtbl.replace env argname argval) funargs params;
Armillon Damien's avatar
Armillon Damien committed
177
  eval_efun oc ep st f "main" params >>= fun (v, st) ->
178
  OK v