fmt
This commit is contained in:
parent
a3c305fb9c
commit
aec53f30e1
1 changed files with 132 additions and 162 deletions
|
@ -387,145 +387,131 @@ and expression' environment memory e =
|
||||||
and E = [runtime.environment], M = [runtime.memory]. *)
|
and E = [runtime.environment], M = [runtime.memory]. *)
|
||||||
and expression pos environment memory = function
|
and expression pos environment memory = function
|
||||||
| Literal l -> literal_expression l.value
|
| Literal l -> literal_expression l.value
|
||||||
|
|
||||||
| Variable (id, _) ->
|
| Variable (id, _) ->
|
||||||
(* On cherche l'id dans l'environnement *)
|
(* On cherche l'id dans l'environnement *)
|
||||||
Environment.lookup id.position id.value environment
|
Environment.lookup id.position id.value environment
|
||||||
|
| Tagged (constructor, _, list_t) ->
|
||||||
| Tagged(constructor,_,list_t) -> (* On ignore le type car on interprète *)
|
(* On ignore le type car on interprète *)
|
||||||
VTagged(constructor.value, List.map(expression' environment memory) list_t)
|
VTagged (constructor.value, List.map (expression' environment memory) list_t)
|
||||||
|
| Record (labels, _) ->
|
||||||
| Record(labels,_) ->
|
VRecord (List.map (pair_labels_gvalue environment memory) labels)
|
||||||
VRecord(List.map((pair_labels_gvalue) (environment) (memory)) labels)
|
| Field (expr, label, _) ->
|
||||||
|
field_value expr label environment memory (* On ignore la liste de type *)
|
||||||
| Field(expr,label,_) -> field_value expr label environment memory
|
|
||||||
(* On ignore la liste de type *)
|
|
||||||
|
|
||||||
| Tuple [] ->
|
| Tuple [] ->
|
||||||
(* Cas pour le Tuple vide
|
(* Cas pour le Tuple vide
|
||||||
* Un tuple vide ne contient rien (logique), donc on utilise un VUnit*)
|
* Un tuple vide ne contient rien (logique), donc on utilise un VUnit*)
|
||||||
VUnit
|
VUnit
|
||||||
| Tuple list_exp -> VTuple (List.map (expression' environment memory) list_exp)
|
| Tuple list_exp -> VTuple (List.map (expression' environment memory) list_exp)
|
||||||
|
(* Sequence : on evalue chaque expression,
|
||||||
(*Sequence : on evalue chaque expression, puis on récupère la dernière à avoir été évalué.
|
* puis on récupère la dernière à avoir été évalué.
|
||||||
Le dernier élément se trouve facilement en faisant un reverse de liste et en récupérant la tête. *)
|
* Le dernier élément se trouve facilement en faisant un reverse de liste
|
||||||
| Sequence(list_expr) -> (let vs = List.map (expression' environment memory) list_expr in List.hd (List.rev vs))
|
* et en récupérant la tête. *)
|
||||||
|
| Sequence list_expr ->
|
||||||
| Define(value_def,expr) ->
|
let vs = List.map (expression' environment memory) list_expr in
|
||||||
let runtime = value_definition { environment; memory} value_def in
|
List.hd (List.rev vs)
|
||||||
|
| Define (value_def, expr) ->
|
||||||
|
let runtime = value_definition { environment; memory } value_def in
|
||||||
expression' runtime.environment runtime.memory expr
|
expression' runtime.environment runtime.memory expr
|
||||||
|
| Fun (FunctionDefinition (pattern, expr)) -> VClosure (environment, pattern, expr)
|
||||||
| Fun (FunctionDefinition(pattern,expr)) -> VClosure(environment, pattern, expr)
|
|
||||||
|
|
||||||
| Apply (f, x) -> apply_expression f x environment memory
|
| Apply (f, x) -> apply_expression f x environment memory
|
||||||
|
|
||||||
| Ref ref ->
|
| Ref ref ->
|
||||||
let dref = expression' environment memory ref in
|
let dref = expression' environment memory ref in
|
||||||
VLocation (Memory.allocate memory Mint.one dref)
|
VLocation (Memory.allocate memory Mint.one dref)
|
||||||
|
| Assign (expr1, expr2) ->
|
||||||
| Assign(expr1,expr2) ->
|
assign_value expr1 expr2 environment memory;
|
||||||
(assign_value expr1 expr2 environment memory ; VUnit)
|
VUnit
|
||||||
|
|
||||||
| Read read ->
|
| Read read ->
|
||||||
let loc = value_as_location (expression' environment memory read) in
|
let loc = value_as_location (expression' environment memory read) in
|
||||||
(match loc with
|
(match loc with
|
||||||
| Some (adr) -> Memory.read (Memory.dereference memory adr) (Mint.zero) (* On lis la valeur de la mémoire*)
|
| Some adr ->
|
||||||
| None -> failwith "erreur") (* TODO : faire une vrai erreur *)
|
Memory.read (Memory.dereference memory adr) Mint.zero
|
||||||
| Case(expr,branch) -> (*case_value expr branch environment memory*)
|
(* On lis la valeur de la mémoire *)
|
||||||
|
| None -> failwith "erreur")
|
||||||
|
(* TODO : faire une vrai erreur *)
|
||||||
|
| Case (expr, branch) ->
|
||||||
|
(* case_value expr branch environment memory *)
|
||||||
(* TODO *)
|
(* TODO *)
|
||||||
failwith "Students! This is your job (Case)!"
|
failwith "Students! This is your job (Case)!"
|
||||||
|
| IfThenElse (expr1, expr2, expr3) ->
|
||||||
| IfThenElse(expr1,expr2,expr3) -> if_then_else_value expr1 expr2 expr3 environment memory
|
if_then_else_value expr1 expr2 expr3 environment memory
|
||||||
|
| While (expr1, expr2) -> while_value expr1 expr2 environment memory pos
|
||||||
| While(expr1,expr2) -> while_value expr1 expr2 environment memory pos
|
| For (id, expr1, expr2, expr3) -> for_value id expr1 expr2 expr3 environment memory
|
||||||
|
|
||||||
| For(id,expr1,expr2,expr3) -> for_value id expr1 expr2 expr3 environment memory
|
|
||||||
|
|
||||||
|
|
||||||
| TypeAnnotation _ -> VUnit
|
| TypeAnnotation _ -> VUnit
|
||||||
(* On ignore le type car on interprète *)
|
(* On ignore le type car on interprète *)
|
||||||
|
|
||||||
(* TODO a finir (à commencer plutôt)*)
|
|
||||||
(*
|
|
||||||
and case_value expr branch environment memory =
|
|
||||||
(*On calcule d'abord l'expression*)
|
|
||||||
let v = expression' environment memory expr in
|
|
||||||
match v with
|
|
||||||
|*)
|
|
||||||
|
|
||||||
and for_value id expr1 expr2 expr3 environment memory =
|
(* TODO a finir (à commencer plutôt)*)
|
||||||
let borne_inf = value_as_int (expression' environment memory expr1) in
|
(* and case_value expr branch environment memory =
|
||||||
let borne_sup = value_as_int (expression' environment memory expr2) in
|
(* On calcule d'abord l'expression *)
|
||||||
match borne_inf, borne_sup with (* On regarde que les borne_inf et borne_sup ont bien une valeur d'entier*)
|
let v = expression' environment memory expr in
|
||||||
(* Si c'est le cas, alors nous sommes bien dans une boucle for et on effectue ses opérations*)
|
match v with
|
||||||
| Some(borne_inf), Some(borne_sup) -> boucle_for id borne_inf borne_sup expr3 environment memory
|
| *)
|
||||||
(* On appelle une seconde fonction car pour évalué la boucle for, il faudra rappeler la boucle
|
|
||||||
en augmentant l'indice de la borne inférieur de 1 à chaque appelle. *)
|
|
||||||
| _ -> error [position expr1; position expr2] "erreur"
|
|
||||||
|
|
||||||
and boucle_for id borne_inf borne_sup expr3 environment memory =
|
and for_value id expr1 expr2 expr3 environment memory =
|
||||||
if borne_inf <= borne_sup (*Cas où nous sommes dans la boucle*)
|
let borne_inf = value_as_int (expression' environment memory expr1) in
|
||||||
then
|
let borne_sup = value_as_int (expression' environment memory expr2) in
|
||||||
let env' = (* On lis l'identifier avec la borne inférieur*)
|
match borne_inf, borne_sup with
|
||||||
Environment.bind environment id.value (int_as_value borne_inf) in
|
(* On regarde que les borne_inf et borne_sup ont bien une valeur d'entier *)
|
||||||
let calcul = expression' environment memory expr3 in
|
(* Si c'est le cas, alors nous sommes bien dans une boucle for et on effectue ses opérations *)
|
||||||
boucle_for id (Mint.add borne_inf Mint.one) borne_sup expr3 env' memory
|
| Some borne_inf, Some borne_sup ->
|
||||||
|
boucle_for id borne_inf borne_sup expr3 environment memory
|
||||||
|
(* On appelle une seconde fonction car pour évalué la boucle for, il faudra rappeler la boucle
|
||||||
|
en augmentant l'indice de la borne inférieur de 1 à chaque appelle. *)
|
||||||
|
| _ -> error [ position expr1; position expr2 ] "erreur"
|
||||||
|
|
||||||
else
|
and boucle_for id borne_inf borne_sup expr3 environment memory =
|
||||||
VUnit (*Cas où nous ne sommes plus dans la boucle, on renvoie un VUnit*)
|
if borne_inf <= borne_sup (* Cas où nous sommes dans la boucle *)
|
||||||
|
then (
|
||||||
|
let env' =
|
||||||
|
(* On lis l'identifier avec la borne inférieur *)
|
||||||
|
Environment.bind environment id.value (int_as_value borne_inf)
|
||||||
|
in
|
||||||
|
let calcul = expression' environment memory expr3 in
|
||||||
|
boucle_for id (Mint.add borne_inf Mint.one) borne_sup expr3 env' memory)
|
||||||
|
else VUnit (* Cas où nous ne sommes plus dans la boucle, on renvoie un VUnit *)
|
||||||
|
|
||||||
|
(* Assign *)
|
||||||
(* Assign *)
|
(* On commence par récupérer l'évaluation de expr1, qui correspond à la valeur
|
||||||
(* On commence par récupérer l'évaluation de expr1, qui correspond à la valeur à laquelle est affecté expr2*)
|
* à laquelle est affecté expr2 *)
|
||||||
and assign_value expr1 expr2 environment memory =
|
and assign_value expr1 expr2 environment memory =
|
||||||
let vall = value_as_location (expression' environment memory expr1) in
|
let vall = value_as_location (expression' environment memory expr1) in
|
||||||
|
|
||||||
(* On regarde ensuite si*)
|
(* On regarde ensuite si*)
|
||||||
match vall with
|
match vall with
|
||||||
| None -> error [position expr1; position expr2] "erreur assign"
|
| None -> error [ position expr1; position expr2 ] "erreur assign"
|
||||||
| Some(v) -> assign_calcul environment memory expr2 v
|
| Some v -> assign_calcul environment memory expr2 v
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
and assign_calcul environment memory expr2 v =
|
and assign_calcul environment memory expr2 v =
|
||||||
let value = expression' environment memory expr2 in
|
let value = expression' environment memory expr2 in
|
||||||
let mem = Memory.dereference memory v in
|
let mem = Memory.dereference memory v in
|
||||||
Memory.write mem Mint.zero value
|
Memory.write mem Mint.zero value
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
and pair_labels_gvalue environment memory (lab, expr) =
|
and pair_labels_gvalue environment memory (lab, expr) =
|
||||||
(Position.value lab, expression' environment memory expr)
|
Position.value lab, expression' environment memory expr
|
||||||
|
|
||||||
and while_value expr1 expr2 environment memory pos =
|
and while_value expr1 expr2 environment memory pos =
|
||||||
let cond = expression' environment memory expr1 in (* On récupère la valeur de la condition *)
|
let cond = expression' environment memory expr1 in
|
||||||
match value_as_bool cond with
|
(* On récupère la valeur de la condition *)
|
||||||
| true ->
|
match value_as_bool cond with
|
||||||
|
| true ->
|
||||||
let expr' = expression' environment memory expr2 in
|
let expr' = expression' environment memory expr2 in
|
||||||
expression pos environment memory (While(expr1,expr2))
|
expression pos environment memory (While (expr1, expr2))
|
||||||
| false -> VUnit
|
| false -> VUnit
|
||||||
|
|
||||||
|
|
||||||
and if_then_else_value expr1 expr2 expr3 environment memory =
|
and if_then_else_value expr1 expr2 expr3 environment memory =
|
||||||
let cond = expression' environment memory expr1 in (* On récupère la valeur de la condition *)
|
let cond = expression' environment memory expr1 in
|
||||||
match value_as_bool cond with
|
(* On récupère la valeur de la condition *)
|
||||||
| true -> expression' environment memory expr2
|
match value_as_bool cond with
|
||||||
(* SI c'est true, alors on évalue la première expression*)
|
| true ->
|
||||||
|
expression' environment memory expr2
|
||||||
|
(* Si c'est true, alors on évalue la première expression *)
|
||||||
| false -> expression' environment memory expr3 (* sinon la deuxième *)
|
| false -> expression' environment memory expr3 (* sinon la deuxième *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
and field_value expr label environment memory =
|
and field_value expr label environment memory =
|
||||||
match expression' environment memory expr with
|
match expression' environment memory expr with
|
||||||
| VRecord record -> List.assoc label.value record
|
| VRecord record -> List.assoc label.value record
|
||||||
| _ -> assert false (* Cas où il n'y a pas de record, donc c'est une erreur*)
|
| _ -> assert false (* Cas où il n'y a pas de record, donc c'est une erreur *)
|
||||||
|
|
||||||
and label_gvalue_pair environment memory (label, expr) =
|
and label_gvalue_pair environment memory (label, expr) =
|
||||||
(Position.value label, expression' environment memory expr)
|
Position.value label, expression' environment memory expr
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
and apply_expression f x environment memory =
|
and apply_expression f x environment memory =
|
||||||
let x_val = expression' environment memory x in
|
let x_val = expression' environment memory x in
|
||||||
|
@ -533,13 +519,13 @@ and apply_expression f x environment memory =
|
||||||
| VPrimitive (_, f) ->
|
| VPrimitive (_, f) ->
|
||||||
(* Fonction "primitive" *)
|
(* Fonction "primitive" *)
|
||||||
f memory x_val
|
f memory x_val
|
||||||
| VClosure (_env_fn, _pattern, _expr) ->(
|
| VClosure (_env_fn, _pattern, _expr) ->
|
||||||
let valeur_pattern = value _pattern in
|
let valeur_pattern = value _pattern in
|
||||||
let pat = pattern _env_fn valeur_pattern x_val in (*Pattern va nous calculer un nouvelle environnement*)
|
let pat = pattern _env_fn valeur_pattern x_val in
|
||||||
match pat with
|
(* Pattern va nous calculer un nouvelle environnement *)
|
||||||
| Some(env') -> expression' env' memory _expr
|
(match pat with
|
||||||
| None -> failwith ("erreur"))
|
| Some env' -> expression' env' memory _expr
|
||||||
|
| None -> failwith "erreur")
|
||||||
| _ -> assert false (* By typing *)
|
| _ -> assert false (* By typing *)
|
||||||
|
|
||||||
and literal_expression = function
|
and literal_expression = function
|
||||||
|
@ -547,90 +533,74 @@ and literal_expression = function
|
||||||
| LChar c -> VChar c
|
| LChar c -> VChar c
|
||||||
| LString s -> VString s
|
| LString s -> VString s
|
||||||
|
|
||||||
|
(* On match le pattern et expression en même temps *)
|
||||||
(*On match le pattern et expression en même temps*)
|
|
||||||
and pattern environment pat expression =
|
and pattern environment pat expression =
|
||||||
match pat, expression with
|
match pat, expression with
|
||||||
|
| PWildcard, _ -> Some environment
|
||||||
|
| PLiteral pl, _ -> literal_pattern pl environment expression
|
||||||
|
| PVariable var, _ -> Some (Environment.bind environment (value var) expression)
|
||||||
|
| PTypeAnnotation (new_pattern, _), _ ->
|
||||||
|
let valeur_pattern = value new_pattern in
|
||||||
|
pattern environment valeur_pattern expression
|
||||||
|
| PTaggedValue (cons, _, new_pattern), VTagged (cons2, new_pattern2) ->
|
||||||
|
tagged_pattern cons cons2 new_pattern new_pattern2 environment
|
||||||
|
| PRecord (r, _), VRecord r2 -> (*TODO*) failwith "erreur"
|
||||||
|
| PTuple tab, VTuple tab2 -> tuple_pattern environment tab tab2
|
||||||
|
| POr pl, _ -> or_pattern environment pl expression
|
||||||
|
| PAnd pl, _ -> and_pattern environment pl expression
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
| PWildcard, _ -> Some(environment)
|
(* On va match les deux listes *)
|
||||||
|
|
||||||
| PLiteral pl, _ -> literal_pattern pl environment expression
|
|
||||||
|
|
||||||
| PVariable var,_ -> Some(Environment.bind environment (value var) expression)
|
|
||||||
|
|
||||||
| PTypeAnnotation(new_pattern,_), _ ->
|
|
||||||
let valeur_pattern = value new_pattern in
|
|
||||||
pattern environment valeur_pattern expression
|
|
||||||
|
|
||||||
| PTaggedValue(cons,_,new_pattern),VTagged(cons2,new_pattern2) -> tagged_pattern cons cons2 new_pattern new_pattern2 environment
|
|
||||||
|
|
||||||
| PRecord(r,_),VRecord(r2) -> (*TODO*)failwith "erreur"
|
|
||||||
|
|
||||||
| PTuple(tab),VTuple(tab2) -> tuple_pattern environment tab tab2
|
|
||||||
|
|
||||||
| POr pl,_ -> or_pattern environment pl expression
|
|
||||||
|
|
||||||
| PAnd pl, _ -> and_pattern env pl expression
|
|
||||||
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
(* On va match les deux listes*)
|
|
||||||
|
|
||||||
and and_pattern env pl expression =
|
and and_pattern env pl expression =
|
||||||
match pl with
|
match pl with
|
||||||
| [] -> Some env
|
| [] -> Some env
|
||||||
| p :: pl' ->
|
| p :: pl' ->
|
||||||
(let valeur_pattern = value p in
|
let valeur_pattern = value p in
|
||||||
match pattern env valeur_pattern expression with
|
(match pattern env valeur_pattern expression with
|
||||||
| None -> None
|
| None -> None
|
||||||
| Some env' -> and_pattern env pl' expression)
|
| Some env' -> and_pattern env pl' expression)
|
||||||
|
|
||||||
|
|
||||||
and or_pattern env pl expression =
|
and or_pattern env pl expression =
|
||||||
match pl with
|
match pl with
|
||||||
| [] -> None
|
| [] -> None
|
||||||
| p :: pl' ->(
|
| p :: pl' ->
|
||||||
let valeur_pattern = value p in
|
let valeur_pattern = value p in
|
||||||
match pattern env valeur_pattern expression with
|
(match pattern env valeur_pattern expression with
|
||||||
| Some (env') -> Some (env')
|
| Some env' -> Some env'
|
||||||
| None -> or_pattern env pl' expression
|
| None -> or_pattern env pl' expression)
|
||||||
)
|
|
||||||
|
|
||||||
and tuple_pattern environment tab tab2 =
|
and tuple_pattern environment tab tab2 =
|
||||||
if List.length tab = List.length tab2 then
|
if List.length tab = List.length tab2
|
||||||
|
then (
|
||||||
match tab, tab2 with
|
match tab, tab2 with
|
||||||
| [], [] -> Some (environment)
|
| [], [] -> Some environment
|
||||||
| pat::tab', expr::tab2' ->
|
| pat :: tab', expr :: tab2' ->
|
||||||
(let valeur_pattern = value pat in
|
let valeur_pattern = value pat in
|
||||||
match pattern environment valeur_pattern expr with
|
(match pattern environment valeur_pattern expr with
|
||||||
| Some (env') -> tuple_pattern env' tab' tab2'
|
| Some env' -> tuple_pattern env' tab' tab2'
|
||||||
| None -> None)
|
| None -> None)
|
||||||
else None
|
| _ -> None)
|
||||||
|
else None
|
||||||
|
|
||||||
and tagged_pattern cons1 cons2 pattern1 pattern2 environment =
|
and tagged_pattern cons1 cons2 pattern1 pattern2 environment =
|
||||||
let valeur_cons1 = value cons1 in
|
let valeur_cons1 = value cons1 in
|
||||||
if valeur_cons1 = cons2 then
|
if valeur_cons1 = cons2 then tuple_pattern environment pattern1 pattern2 else None
|
||||||
tuple_pattern environment pattern1 pattern2
|
|
||||||
else None
|
|
||||||
|
|
||||||
(*
|
(*
|
||||||
and variable_pattern environment var expression =
|
and variable_pattern environment var expression =
|
||||||
let valeur_var = value var in
|
let valeur_var = value var in
|
||||||
Some(Environment.bind environment var expression)
|
Some(Environment.bind environment var expression)
|
||||||
*)
|
*)
|
||||||
|
|
||||||
and literal_pattern pl environment expression =
|
and literal_pattern pl environment expression =
|
||||||
let valeur_pl = value pl in
|
let valeur_pl = value pl in
|
||||||
let verif_literal l1 l2 =
|
let verif_literal l1 l2 = if l1 = l2 then Some environment else None in
|
||||||
if l1 = l2 then Some(environment) else None in
|
|
||||||
match valeur_pl, expression with
|
match valeur_pl, expression with
|
||||||
| LInt int1, VInt int2 -> verif_literal int1 int2
|
| LInt int1, VInt int2 -> verif_literal int1 int2
|
||||||
| LChar char1, VChar char2 -> verif_literal char1 char2
|
| LChar char1, VChar char2 -> verif_literal char1 char2
|
||||||
| LString str1, VString str2 -> verif_literal str1 str2
|
| LString str1, VString str2 -> verif_literal str1 str2
|
||||||
| _ -> None
|
| _ -> None
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(** This function returns the difference between two runtimes. *)
|
(** This function returns the difference between two runtimes. *)
|
||||||
and extract_observable runtime runtime' =
|
and extract_observable runtime runtime' =
|
||||||
|
|
Reference in a new issue