This repository has been archived by the owner on Mar 16, 2023. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
/
interpreter.ml
169 lines (144 loc) · 5.27 KB
/
interpreter.ml
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
(* Interprète Mini-ML *)
open Mml
(* Environnement : associe les pointeurs aux noms des variables *)
module Env = Map.Make(String)
(* Valeurs *)
type value =
| VInt of int
| VBool of bool
| VUnit
| VPtr of int
(* Élements du tas *)
type heap_value =
| VClos of string * expr * value Env.t
| VStrct of (string, value) Hashtbl.t
let print_value = function
| VInt n -> Printf.printf "%d\n" n
| VBool b -> Printf.printf "%b\n" b
| VUnit -> Printf.printf "()\n"
| VPtr p -> Printf.printf "@%d\n" p
(* Interprétation d'un programme complet *)
let eval_prog (p: prog): value =
(* Initialisation de la mémoire globale qui stocke les heap_value *)
let (mem: (value, heap_value) Hashtbl.t) = Hashtbl.create 16 in
(* Création de nouvelles adresses *)
let new_ptr =
let cpt = ref 0 in
fun () -> incr cpt; !cpt
in
(* Interprétation d'une expression, en fonction d'un environnement
et de la mémoire globale *)
let rec eval (e: expr) (env: value Env.t): value =
match e with
| Int n -> VInt n
| Bool b -> VBool b
| Unit -> VUnit
| Uop(Neg, e) -> VInt (-(evali e env))
| Uop(Not, e) -> VBool (not (evalb e env))
| Bop(Sub, e1, e2) -> VInt (evali e1 env - evali e2 env)
| Bop(Add, e1, e2) -> VInt (evali e1 env + evali e2 env)
| Bop(Mul, e1, e2) -> VInt (evali e1 env * evali e2 env)
| Bop(Div, e1, e2) -> VInt (evali e1 env / evali e2 env)
| Bop(Mod, e1, e2) -> VInt (evali e1 env mod evali e2 env)
| Bop(And, e1, e2) -> VBool (evalb e1 env && evalb e2 env)
| Bop(Or, e1, e2) -> VBool (evalb e1 env || evalb e2 env)
| Bop(Lt, e1, e2) -> VBool (evali e1 env < evali e2 env)
| Bop(Le, e1, e2) -> VBool (evali e1 env <= evali e2 env)
| Bop(Eq, e1, e2) -> VBool (evali e1 env == evali e2 env)
| Bop(Neq, e1, e2) -> VBool (evali e1 env != evali e2 env)
| If(e0, e1, e2) -> if evalb e0 env then evalv e1 env else evalv e2 env
| Let(id, e1, e2) ->
let ptr = VPtr(new_ptr()) in
let env_extended = Env.add id ptr env in
let data = VClos(id, e1, env) in
let _ = Hashtbl.add mem ptr data in
evalv e2 env_extended
| Var(x) ->
let ptr = Env.find x env in
let VClos(_, e, env) = Hashtbl.find mem ptr in
evalv e env
| Seq(e1, e2) -> (evalv e1 env); (evalv e2 env)
| Fun(x, _, e) ->
let ptr = VPtr(new_ptr()) in
let env_extended = Env.add x ptr env in
let data = VClos(x, e, env_extended) in
let _ = Hashtbl.add mem ptr data in
ptr
| App(f, e) ->
(* On récupère le pointeur de la fonction f *)
let ptrf = evalv f env in
(* On récupère la cloture fonctionnelle de f *)
let VClos(funx, expfun, envfun) = Hashtbl.find mem ptrf in
(*
On étend l'environnement où le paramètre x de f est associée à la valeur de e.
x -> eval(e)
*)
let ptrx = VPtr(new_ptr()) in
let envx = Env.add funx ptrx envfun in
let datax = VClos(funx, e, envfun) in
let _ = Hashtbl.add mem ptrx datax in
(* On évalue l'expression de f dans l'environnement de x *)
evalv expfun envx
| Fix(f, _, e) ->
let ptr = VPtr(new_ptr()) in
let envf = Env.add f ptr env in
let dataf = VClos(f, e, envf) in
let _ = Hashtbl.add mem ptr dataf in
(* On met à jour l'environnement de la cloture fonctionnelle en y ajoutant une association f -> ptr *)
let VClos(_, _, env) = dataf in
let new_env = Env.add f ptr env in
let new_dataf = VClos(f, e, new_env) in
let _ = Hashtbl.replace mem ptr new_dataf in
ptr
(*| GetF(e, x) ->
let eval_e = eval e env (* e reconnu comme Var(x) : renvoie pointeur adresse *)
in
let l = Hashtbl.find mem eval_e (* heap_value *)
in
match l with
|VStrct(hash) -> Hashtbl.find hash x
|_ -> assert false
| SetF(e1, x, e2) -> let eval_e1 = eval e1 env and eval_e2 = evalv e2 env
in
let l = Hashtbl.find mem eval_e1
in
match l with
|VStrct(hash) -> Hashtbl.replace hash x eval_e2
|_ -> assert false
*)
| Strct(s) ->
let rec new_hash_strct s hash = match s with
| h::t -> Hashtbl.add hash (fst h) (snd h); new_hash_strct t hash
| [] -> ()
in
let ptr = VPtr(new_ptr()) and hash = Hashtbl.create 2 and st = evals s env in
new_hash_strct st hash;
let data = VStrct(hash) in
let _ = Hashtbl.add mem ptr data in
ptr
(*| Enum(c) -> c*)
(* Évaluation d'une expression dont la valeur est supposée entière *)
and evali (e: expr) (env: value Env.t): int =
match eval e env with
| VInt n -> n
| _ -> assert false
(* Évaluation d'une expression dont la valeur est supposée booléenne *)
and evalb (e: expr) (env: value Env.t): bool =
match eval e env with
| VBool b -> b
| _ -> assert false
(* Évaluation d'une expression dont la valeur est supposée de type value *)
and evalv (e: expr) (env: value Env.t) =
match eval e env with
| VBool b -> VBool b
| VInt n -> VInt n
| VUnit -> VUnit
| VPtr p -> VPtr p
| _ -> assert false
and evals s (env: value Env.t) =
let l = [] in
match s with
|h::t -> (fst h,evalv (snd h) env)::evals t env
|[] -> l
in
eval p.code Env.empty