Paris7/compilation
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Activity

fmt

Browse source
This commit is contained in:
Mylloon 2023-11-14 17:01:38 +01:00
parent c7c9b0c351
commit 6f097cba99
Signed by: Anri
GPG key ID: A82D63DFF8D1317F
1 changed files with 101 additions and 108 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

177
flap/src/hopix/hopixInterpreter.ml
View file

@ -344,7 +344,7 @@ and definition runtime d =
and value_definition runtime = function and value_definition runtime = function
| SimpleValue (id, _, expr) -> | SimpleValue (id, _, expr) ->
(* Ici on associe l'ID et l'expression (* Ici on associe l'ID et l'expression
* => Retourne l'environnement modifié *) => Retourne l'environnement modifié *)
let env' = let env' =
Environment.bind Environment.bind
runtime.environment runtime.environment
@ -354,14 +354,13 @@ and value_definition runtime = function
{ runtime with environment = env' } { runtime with environment = env' }
| RecFunctions rf -> | RecFunctions rf ->
(* Ici on ajoute les noms des fonctions à l'environnement (* Ici on ajoute les noms des fonctions à l'environnement
* pour qu'elles puissent s'appeller dans leur corps de fonction pour qu'elles puissent s'appeller dans leur corps de fonction
* => Retourne l'environnement modifié *) => Retourne l'environnement modifié *)
(* TODO *)
{ runtime with environment = define_rec runtime.environment rf } { runtime with environment = define_rec runtime.environment rf }
and define_rec env rf = and define_rec env rf =
(* Ajoute les fonctions récursives dans l'environnement (* Ajoute les fonctions récursives dans l'environnement
* par défaut on dit qu'elle renvoie Unit *) par défaut on dit qu'elle renvoie Unit *)
let env' = let env' =
List.fold_left List.fold_left
(fun curr_env (id, _, _) -> Environment.bind curr_env id.value VUnit) (fun curr_env (id, _, _) -> Environment.bind curr_env id.value VUnit)
@ -369,7 +368,7 @@ and define_rec env rf =
rf rf
in in
(* On associe les fonctions avec leur contenu en ignorant le type via (* On associe les fonctions avec leur contenu en ignorant le type via
* une closure en les rajoutant à l'environnement *) une closure en les rajoutant à l'environnement *)
List.iter List.iter
((fun env'' (name, _, FunctionDefinition (pattern, expr)) -> ((fun env'' (name, _, FunctionDefinition (pattern, expr)) ->
Environment.update name.position name.value env'' (VClosure (env'', pattern, expr))) Environment.update name.position name.value env'' (VClosure (env'', pattern, expr)))
@ -394,67 +393,68 @@ and expression pos environment memory = function
| 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 (expr, label, _) ->
field_value expr label environment memory (* On ignore la liste de type *) (* On ignore la liste de type *)
| Tuple [] -> (* Cas pour le Tuple vide. Un tuple vide ne contient rien (logique), donc on utilise un VUnit*) field_value expr label environment memory
| Tuple [] ->
(* Cas pour le Tuple vide. Un tuple vide ne contient rien (logique),
donc on utilise un VUnit *)
VUnit VUnit
| Tuple list_expr -> | Tuple list_expr -> tuple_value list_expr environment memory
tuple_value list_expr environment memory | Sequence list_expr -> sequence_value list_expr environment memory
| Sequence list_expr -> | Define (value_def, expr) -> define_value value_def expr environment memory
sequence_value list_expr environment memory
| Define (value_def, expr) ->
define_value value_def expr environment memory
| 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_value ref environment memory | Ref ref -> ref_value ref environment memory
| Assign (expr1, expr2) -> | Assign (expr1, expr2) ->
assign_value expr1 expr2 environment memory; VUnit assign_value expr1 expr2 environment memory;
VUnit
| Read read -> read_value read environment memory | Read read -> read_value read environment memory
| Case (expr, branches) -> | Case (expr, branches) -> case_value expr branches environment memory
case_value expr branches environment memory
| 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 _ ->
(* On ignore le type car on interprète *) (* On ignore le type car on interprète *)
VUnit
(* Variable : On cherche la variable dans l'environnement *) (** Variable: On cherche la variable dans l'environnement *)
and variable_value id environment = and variable_value id environment = Environment.lookup id.position id.value environment
Environment.lookup id.position id.value environment
(* Tuple : On applique à chaque expression de la liste l'opération de calcul de sa valeur *) (** Tuple: On applique à chaque expression de la liste l'opération de calcul de sa valeur *)
and tuple_value list_expr environment memory = and tuple_value list_expr environment memory =
VTuple (List.map (expression' environment memory) list_expr) VTuple (List.map (expression' environment memory) list_expr)
(* 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 Le dernier élément se trouve facilement en faisant un reverse de liste
* et en récupérant la tête. *) et en récupérant la tête. *)
and sequence_value list_expr environment memory = and sequence_value list_expr environment memory =
let vs = List.map (expression' environment memory) list_expr in let vs = List.map (expression' environment memory) list_expr in
List.hd (List.rev vs) List.hd (List.rev vs)
(*Define : On évalue la définition local puis on en fait un nouveau runtime et on calcule la valeur de l'expression. *) (** Define: On évalue la définition local puis on en fait un nouveau runtime et
on calcule la valeur de l'expression. *)
and define_value value_def expr environment memory = and define_value value_def expr environment memory =
let runtime = value_definition { environment; memory } value_def in let runtime = value_definition { environment; memory } value_def in
expression' runtime.environment runtime.memory expr expression' runtime.environment runtime.memory expr
(* Reference : On alloue de la mémoire pour le résultat du calcul de l'expression *) (** Reference: On alloue de la mémoire pour le résultat du calcul de l'expression *)
and ref_value ref environment memory = and ref_value ref environment memory =
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)
(* Lecture : On va lire l'espace mémoire *) (** Lecture: On va lire l'espace mémoire *)
and read_value read environment memory = and read_value read environment memory =
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 -> | Some adr ->
Memory.read (Memory.dereference memory adr) Mint.zero Memory.read (Memory.dereference memory adr) Mint.zero
(* On lis la valeur de la mémoire *) (* On lis la valeur de la mémoire *)
| None -> error [position read] "Erreur read") | None -> error [ position read ] "Erreur read"
(* Case : On effectue le pattern matching des branches associés à notre case, (** Case: On effectue le pattern matching des branches associés à notre case,
* et on renvoie l'environnement modifié après avoir calculer toute les branches. *) et on renvoie l'environnement modifié après avoir calculer toute les branches. *)
and case_value expr branches environment memory = and case_value expr branches environment memory =
(* On calcule d'abord l'expression *) (* On calcule d'abord l'expression *)
let expr' = expression' environment memory expr in let expr' = expression' environment memory expr in
@ -478,17 +478,20 @@ and case_value expr branches environment memory =
| [] -> error [ expr.position ] "erreur" | [] -> error [ expr.position ] "erreur"
| _ as env -> List.hd env | _ as env -> List.hd env
(* For : On va calculer les valeurs de l'expression (ici expr3) à chaque itération de la boucle *) (** For: On va calculer les valeurs de l'expression (ici expr3)
à chaque itération de la boucle *)
and for_value id expr1 expr2 expr3 environment memory = and for_value id expr1 expr2 expr3 environment memory =
let borne_inf = value_as_int (expression' environment memory expr1) in let borne_inf = value_as_int (expression' environment memory expr1) in
let borne_sup = value_as_int (expression' environment memory expr2) in let borne_sup = value_as_int (expression' environment memory expr2) in
match borne_inf, borne_sup with match borne_inf, borne_sup with
(* On regarde que les borne_inf et borne_sup ont bien une valeur d'entier *) (* On regarde que les borne_inf et borne_sup ont bien une valeur d'entier
(* Si c'est le cas, alors nous sommes bien dans une boucle for et on effectue ses opérations *) Si c'est le cas, alors nous sommes bien dans une boucle for et on effectue
ses opérations *)
| Some borne_inf, Some borne_sup -> | Some borne_inf, Some borne_sup ->
boucle_for id borne_inf borne_sup expr3 environment memory 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 (* On appelle une seconde fonction car pour évalué la boucle for, il faudra
en augmentant l'indice de la borne inférieur de 1 à chaque appelle. *) rappeler la boucle en augmentant l'indice de la borne inférieur de 1
à chaque appelle. *)
| _ -> error [ expr1.position; expr2.position ] "erreur" | _ -> error [ expr1.position; expr2.position ] "erreur"
and boucle_for id borne_inf borne_sup expr3 environment memory = and boucle_for id borne_inf borne_sup expr3 environment memory =
@ -502,12 +505,11 @@ and boucle_for id borne_inf borne_sup expr3 environment memory =
boucle_for id (Mint.add borne_inf Mint.one) borne_sup expr3 env' memory) 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 *) 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 [ expr1.position; expr2.position ] "erreur assign" | None -> error [ expr1.position; expr2.position ] "erreur assign"
| Some v -> assign_calcul environment memory expr2 v | Some v -> assign_calcul environment memory expr2 v
@ -517,9 +519,11 @@ and assign_calcul environment memory expr2 v =
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
(** While: Tant que la condition (valeur de l'expression 1) est true,
alors on calcule l'expression de expression 2
(*While : Tant que la condition (valeur de l'expression 1) est true, alors on calcule l'expression de expression 2 Sinon, on renvoie un VUnit, qui va stopper le processus d'interprétation
Sinon, on renvoie un VUnit, qui va stopper le processus d'interprétation pour While. *) pour While. *)
and while_value expr1 expr2 environment memory pos = and while_value expr1 expr2 environment memory pos =
let cond = expression' environment memory expr1 in let cond = expression' environment memory expr1 in
(* On récupère la valeur de la condition *) (* On récupère la valeur de la condition *)
@ -529,8 +533,9 @@ and while_value expr1 expr2 environment memory pos =
expression pos environment memory (While (expr1, expr2)) expression pos environment memory (While (expr1, expr2))
| false -> VUnit | false -> VUnit
(* IfThenELse : Comme pour While, on regarde si la condition est vrai, si c'est le cas, (** IfThenELse: Comme pour While, on regarde si la condition est vrai,
alors on calcule l'expression du "then", sinon celle du "else" *) si c'est le cas, alors on calcule l'expression du "then",
sinon celle du "else" *)
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 let cond = expression' environment memory expr1 in
(* On récupère la valeur de la condition *) (* On récupère la valeur de la condition *)
@ -540,18 +545,18 @@ and if_then_else_value expr1 expr2 expr3 environment memory =
(* Si c'est true, alors on évalue la première expression *) (* 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 *)
(* Record : on calcule l'expression, et on associe à chaque élément de la liste la valeur du label *) (** Record: on calcule l'expression, et on associe à chaque élément
de la liste la valeur du label *)
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 *)
(* Fonction annexe qui renverra une paire label * valeur de expression *) (** Fonction annexe qui renverra une paire label * valeur de expression *)
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
(** Apply: On applique la fonction f à x en fonction des différents cas possibles *)
(* Apply : on applique la fonction f à x en fonction des différents cas possibles *)
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
match expression' environment memory f with match expression' environment memory f with
@ -567,19 +572,14 @@ and apply_expression f x environment memory =
| None -> failwith "erreur") | None -> failwith "erreur")
| _ -> assert false (* By typing *) | _ -> assert false (* By typing *)
(* Littéraux *) (** Littéraux *)
and literal_expression = function and literal_expression = function
| LInt n -> VInt n | LInt n -> VInt n
| LChar c -> VChar c | LChar c -> VChar c
| LString s -> VString s | LString s -> VString s
(* --------------- PATTERN MATCHING ----------------- *) (* --------------- PATTERN MATCHING ----------------- *)
and pattern environment pat expression = and pattern environment pat expression =
match pat, expression with match pat, expression with
| PWildcard, _ -> wildcard_pattern environment | PWildcard, _ -> wildcard_pattern environment
@ -595,14 +595,16 @@ and pattern environment pat expression =
| PAnd pl, _ -> and_pattern environment pl expression | PAnd pl, _ -> and_pattern environment pl expression
| _ -> None | _ -> None
(* PWildcard : on renvoie l'environnement sans modification *) (** PWildcard: On renvoie l'environnement sans modification *)
and wildcard_pattern environment = Some environment and wildcard_pattern environment = Some environment
(* PVariable : On bind la valeur de la variable ) l'expression dans l'environnement *)
(** PVariable: On bind la valeur de la variable - l'expression dans l'environnement *)
and variable_pattern var env expression = Some (Environment.bind env var.value expression) and variable_pattern var env expression = Some (Environment.bind env var.value expression)
(* PTypeAnnotation : On calcule le pattern à son tour *)
(** PTypeAnnotation: On calcule le pattern à son tour *)
and typeannot_pattern pattern' env expression = pattern env pattern' expression and typeannot_pattern pattern' env expression = pattern env pattern' expression
(* PLiteral : On regarde si la valeur du pattern correspond à celle de l'expression *) (** PLiteral: On regarde si la valeur du pattern correspond à celle de l'expression *)
and literal_pattern pl environment expression = and literal_pattern pl environment expression =
let valeur_literal = pl.value in let valeur_literal = pl.value in
let verif_literal l1 l2 = if l1 = l2 then Some environment else None in let verif_literal l1 l2 = if l1 = l2 then Some environment else None in
@ -612,37 +614,38 @@ and literal_pattern pl environment expression =
| LString str1, VString str2 -> verif_literal str1 str2 | LString str1, VString str2 -> verif_literal str1 str2
| _ -> None | _ -> None
(* PTagged : On regarde si les deux constructeurs sont égaux, si c'est le cas on calcule (** PTagged: On regarde si les deux constructeurs sont égaux, si c'est le cas
comme si c'était un PTuple, les deux listes de patterns que nous avons *) on calcule comme si c'était un PTuple, les deux listes de patterns que
nous avons *)
and tagged_pattern cons1 cons2 pattern1 pattern2 environment = and tagged_pattern cons1 cons2 pattern1 pattern2 environment =
if cons1.value = cons2 then tuple_pattern environment pattern1 pattern2 else None if cons1.value = cons2 then tuple_pattern environment pattern1 pattern2 else None
(*PRecord On compare les deux records, on essaye de trouver un match pour chaque field (** PRecord: On compare les deux records, on essaye de trouver un match pour
(du premier record) dans le deuxième record, si c'est le cas on met à jour l'env, sinon chaque field (du premier record) dans le deuxième record, si c'est le cas
On regarde le prochain élément. *) on met à jour l'env, sinon on regarde le prochain élément. *)
and record_pattern environment r r' = and record_pattern environment r r' =
match r with match r with
| [] -> Some environment | [] -> Some environment
| field :: reste -> | field :: reste ->
let labbel_pattern = record_labbel_pattern environment field r' in let labbel_pattern = record_label_pattern environment field r' in
match labbel_pattern with (match labbel_pattern with
| Some env' -> record_pattern env' reste r' | Some env' -> record_pattern env' reste r'
| None -> None | None -> None)
(* Auxillaire *)
and record_labbel_pattern environment field r' = and record_label_pattern environment field r' =
match r' with match r' with
| [] -> None | [] -> None
| (label,pat) :: reste -> | (label, pat) :: reste ->
if (value (fst field)) = label then if value (fst field) = label
then (
match pattern environment (value (snd field)) pat with match pattern environment (value (snd field)) pat with
| Some env' -> Some env' | Some env' -> Some env'
| None -> record_labbel_pattern environment field reste | None -> record_label_pattern environment field reste)
else else record_label_pattern environment field reste
record_labbel_pattern environment field reste
(* PTuple : On a deux tuples, qui pour chaque pair d'éléments effectue un pattern matching, et (** PTuple: On a deux tuples, qui pour chaque pair d'éléments effectue
renvoie le nouvel environnement *) un pattern matching, et renvoie le nouvel environnement *)
and tuple_pattern environment tab tab2 = and tuple_pattern environment tab tab2 =
if List.length tab = List.length tab2 if List.length tab = List.length tab2
then ( then (
@ -656,7 +659,8 @@ and tuple_pattern environment tab tab2 =
| _ -> None) | _ -> None)
else None else None
(* POr : Renvoie le nouvelle environnement si au moins un des patterns match avec l'expression*) (** Por: Renvoie le nouvelle environnement si au moins un des
patterns match avec l'expression *)
and or_pattern env pl expression = and or_pattern env pl expression =
match pl with match pl with
| [] -> None | [] -> None
@ -666,7 +670,8 @@ and or_pattern env pl expression =
| Some env' -> Some env' | Some env' -> Some env'
| None -> or_pattern env pl' expression) | None -> or_pattern env pl' expression)
(* PAnd : de même, mais chaque élément de la liste des patterns doivent matchs avec l'expression*) (** PAnd: De même, mais chaque élément de la liste des patterns doivent
matchs avec l'expression *)
and and_pattern env pl expression = and and_pattern env pl expression =
match pl with match pl with
| [] -> Some env | [] -> Some env
@ -676,18 +681,6 @@ and and_pattern env pl expression =
| None -> None | None -> None
| Some env' -> and_pattern env' pl' expression) | Some env' -> and_pattern env' pl' expression)
(** 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' =
let rec substract new_environment env env' = let rec substract new_environment env env' =