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-12 18:11:36 +01:00
parent a3c305fb9c
commit aec53f30e1
Signed by: Anri
GPG key ID: A82D63DFF8D1317F
1 changed files with 132 additions and 162 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -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)*) (* TODO a finir (à commencer plutôt)*)
(* (* and case_value expr branch environment memory =
and case_value expr branch environment memory = (* On calcule d'abord l'expression *)
(*On calcule d'abord l'expression*) let v = expression' environment memory expr in
let v = expression' environment memory expr in match v with
match v with | *)
|*)
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 (* On regarde que les borne_inf et borne_sup ont bien une valeur d'entier*) match borne_inf, borne_sup with
(* Si c'est le cas, alors nous sommes bien dans une boucle for et on effectue ses opérations*) (* On regarde que les borne_inf et borne_sup ont bien une valeur d'entier *)
| Some(borne_inf), Some(borne_sup) -> boucle_for id borne_inf borne_sup expr3 environment memory (* Si c'est le cas, alors nous sommes bien dans une boucle for et on effectue ses opérations *)
(* On appelle une seconde fonction car pour évalué la boucle for, il faudra rappeler la boucle | Some borne_inf, Some borne_sup ->
en augmentant l'indice de la borne inférieur de 1 à chaque appelle. *) boucle_for id borne_inf borne_sup expr3 environment memory
| _ -> error [position expr1; position expr2] "erreur" (* 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 boucle_for id borne_inf borne_sup expr3 environment memory =
if borne_inf <= borne_sup (*Cas où nous sommes dans la boucle*) if borne_inf <= borne_sup (* Cas où nous sommes dans la boucle *)
then then (
let env' = (* On lis l'identifier avec la borne inférieur*) let env' =
Environment.bind environment id.value (int_as_value borne_inf) in (* On lis l'identifier avec la borne inférieur *)
let calcul = expression' environment memory expr3 in Environment.bind environment id.value (int_as_value borne_inf)
boucle_for id (Mint.add borne_inf Mint.one) borne_sup expr3 env' memory 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 *)
else (* Assign *)
VUnit (*Cas où nous ne sommes plus dans la boucle, on renvoie un VUnit*) (* On commence par récupérer l'évaluation de expr1, qui correspond à la valeur
* à laquelle est affecté expr2 *)
(* Assign *)
(* On commence par récupérer l'évaluation de expr1, qui correspond à la valeur à 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
(* On récupère la valeur de la condition *)
match value_as_bool cond with match value_as_bool cond with
| true -> | 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
(* On récupère la valeur de la condition *)
match value_as_bool cond with match value_as_bool cond with
| true -> expression' environment memory expr2 | true ->
(* SI c'est true, alors on évalue la première expression*) 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,91 +533,75 @@ 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' =
let rec substract new_environment env env' = let rec substract new_environment env env' =