elang_run.ml 5.59 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
33
34
35

(* [eval_eexpr st e] évalue l'expression [e] dans l'état [st]. Renvoie une
   erreur si besoin. *)
let rec eval_eexpr st (e : expr) : int res =
Armillon Damien's avatar
Armillon Damien committed
36
37
38
39
40
41
42
43
44
   let {env} = st in
   match e with
   | Ebinop(op,expr1,expr2) ->
      eval_eexpr st expr1 >>= fun value1 ->
      eval_eexpr st expr2 >>= fun value2 ->
          OK(eval_binop op value1 value2)
   | Eunop(op,expr) -> eval_eexpr st expr >>= fun value -> OK(eval_unop op value)
   | Evar(str) ->
      (match Hashtbl.find_option env str with 
Armillon Damien's avatar
Armillon Damien committed
45
      | None -> Error (Format.sprintf "Unknown variable %s\n" str)
Armillon Damien's avatar
Armillon Damien committed
46
47
      | Some(n) -> OK(n))
   | Eint(n) -> OK(n)
48

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

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

54
   Cette fonction renvoie [(ret, st')] :
55

56
57
58
   - [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.
59

60
   - [st'] est l'état mis à jour. *)
61
62
let rec eval_einstr oc (st: int state) (ins: instr) :
  (int option * int state) res =
Armillon Damien's avatar
Armillon Damien committed
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
  let {env} = st in
  let rec eval_list_instrs st li : (int option * int state) res =
   match li with 
   | [] -> OK(None,st)
   | instr::next_instrs -> eval_einstr oc st instr >>= fun result ->
       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 =
   eval_eexpr st e >>= fun condition ->
      if condition=1 then 
         eval_einstr oc st i >>= fun result_loop ->
         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
   | Iassign(str, expr) -> eval_eexpr st expr >>= fun value -> Hashtbl.replace env str value; OK(None,st)
   | Iif(expr,instr1,instr2) -> eval_eexpr st expr >>=
       fun condition -> if condition=1 then eval_einstr oc st instr1 else eval_einstr oc st instr2
   | Iwhile(expr,instr) -> eval_while st expr instr
   | Iblock(instrs) -> eval_list_instrs st instrs
   | Ireturn(expr) -> eval_eexpr st expr >>= fun result -> OK(Some(result), st)
   | Iprint(expr) -> eval_eexpr st expr >>= fun result -> Format.fprintf oc "%d\n" result; OK(None, st)
89

90
91
(* [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].
92

93
94
   Cette fonction renvoie un couple (ret, st') avec la même signification que
   pour [eval_einstr]. *)
95
96
97
let eval_efun oc (st: int state) ({ funargs; funbody}: efun)
    (fname: string) (vargs: int list)
  : (int option * int state) res =
98
99
100
101
102
  (* 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. *)
103
104
105
106
107
108
109
110
111
112
113
114
  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
  | () ->
    eval_einstr oc { st with env } funbody >>= fun (v, st') ->
    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)
          )

115
(* [eval_eprog oc ep memsize params] évalue un programme complet [ep], avec les
116
117
   arguments [params].

118
119
120
121
   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.
122

123
124
125
126
127
128
129
130
   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.
   *)
131
132
133
134
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 ->
135
  (* ne garde que le nombre nécessaire de paramètres pour la fonction "main". *)
136
137
  let n = List.length f.funargs in
  let params = take n params in
Armillon Damien's avatar
Armillon Damien committed
138
139
140
  let { env } = st in
  let { funargs } = f in
  List.iter2 (fun argname argval -> Hashtbl.replace env argname argval) funargs params;
141
142
  eval_efun oc st f "main" params >>= fun (v, st) ->
  OK v