fmt

flap/src/hopix/hopixInterpreter.ml

@@ -387,67 +387,60 @@ and expression' environment memory e =
     and E = [runtime.environment], M = [runtime.memory]. *)
 and expression pos environment memory = function
   | Literal l -> literal_expression l.value
-
   | Variable (id, _) ->
     (* On cherche l'id dans l'environnement *)
     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)
-
   | 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 
+    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*)
     VUnit
   | 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 ->
+    let vs = List.map (expression' environment memory) list_expr 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
-
   | Fun (FunctionDefinition (pattern, expr)) -> VClosure (environment, pattern, expr)
-
   | Apply (f, x) -> apply_expression f x environment memory
-  
   | Ref ref ->
     let dref = expression' environment memory ref in
     VLocation (Memory.allocate memory Mint.one dref)
-
   | Assign (expr1, expr2) ->
-    (assign_value expr1 expr2 environment memory ; VUnit)
+    assign_value expr1 expr2 environment memory;
-
+    VUnit
   | Read read ->
     let loc = value_as_location (expression' environment memory read) in
     (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 *)
     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
-
   | For (id, expr1, expr2, expr3) -> for_value id expr1 expr2 expr3 environment memory
-  
-
   | TypeAnnotation _ -> VUnit
 (* On ignore le type car on interprète *)
 
 (* 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 *)
    let v = expression' environment memory expr in
    match v with
@@ -456,76 +449,69 @@ and case_value expr branch environment memory =
 and for_value id expr1 expr2 expr3 environment memory =
   let borne_inf = value_as_int (expression' environment memory expr1) 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
+  (* 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 *)
-    | Some(borne_inf), Some(borne_sup) -> boucle_for id borne_inf borne_sup expr3 environment 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"
 
 and boucle_for id borne_inf borne_sup expr3 environment memory =
   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 *)
+      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
+    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 *)
-  (* On commence par récupérer l'évaluation de expr1, qui correspond à la valeur à laquelle est affecté expr2*)
+(* 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 =
   let vall = value_as_location (expression' environment memory expr1) in
-
   (* On regarde ensuite si*)
   match vall with
   | 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 =
   let value = expression' environment memory expr2 in
   let mem = Memory.dereference memory v in
   Memory.write mem Mint.zero value
 
-
-
-
-
 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 =
-  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
   | true ->
     let expr' = expression' environment memory expr2 in
     expression pos environment memory (While (expr1, expr2))
   | false -> VUnit
 
-
 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
-  | 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 *)
 
-
-
 and field_value expr label environment memory =
   match expression' environment memory expr with
   | VRecord record -> List.assoc label.value record
   | _ -> assert false (* Cas où il n'y a pas de record, donc c'est une erreur *)
 
 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 =
   let x_val = expression' environment memory x in
@@ -533,13 +519,13 @@ and apply_expression f x environment memory =
   | VPrimitive (_, f) ->
     (* Fonction "primitive" *)
     f memory x_val
-  | VClosure (_env_fn, _pattern, _expr) ->(
+  | VClosure (_env_fn, _pattern, _expr) ->
     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 *)
 
 and literal_expression = function
@@ -547,31 +533,21 @@ and literal_expression = function
   | LChar c -> VChar c
   | LString s -> VString s
 
-  
 (* On match le pattern et expression en même temps *)
 and pattern environment pat expression =
   match pat, expression with
-
+  | PWildcard, _ -> Some environment
-    | 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) ->
-    | PTaggedValue(cons,_,new_pattern),VTagged(cons2,new_pattern2) -> tagged_pattern cons cons2 new_pattern new_pattern2 environment
+    tagged_pattern cons cons2 new_pattern new_pattern2 environment
-        
+  | PRecord (r, _), VRecord r2 -> (*TODO*) failwith "erreur"
-    | PRecord(r,_),VRecord(r2) -> (*TODO*)failwith "erreur"
+  | PTuple tab, VTuple tab2 -> tuple_pattern environment tab tab2
-    
-    | PTuple(tab),VTuple(tab2) -> tuple_pattern environment tab tab2
-
   | POr pl, _ -> or_pattern environment pl expression
-
+  | PAnd pl, _ -> and_pattern environment pl expression
-    | PAnd pl, _ -> and_pattern env pl expression
-
   | _ -> None
 
 (* On va match les deux listes *)
@@ -580,39 +556,36 @@ and and_pattern env pl expression =
   match pl with
   | [] -> Some env
   | 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
      | Some env' -> and_pattern env pl' expression)
 
-
 and or_pattern env pl expression =
   match pl with
   | [] -> None
-  | p :: pl' ->(
+  | p :: pl' ->
     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 =
-  if List.length tab = List.length tab2 then
+  if List.length tab = List.length tab2
+  then (
     match tab, tab2 with
-    | [], [] -> Some (environment)
+    | [], [] -> Some environment
     | 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)
   else None
 
-
 and tagged_pattern cons1 cons2 pattern1 pattern2 environment =
   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 =
@@ -622,16 +595,13 @@ and variable_pattern environment var expression =
 
 and literal_pattern pl environment expression =
   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
   | LInt int1, VInt int2 -> verif_literal int1 int2
   | LChar char1, VChar char2 -> verif_literal char1 char2
   | LString str1, VString str2 -> verif_literal str1 str2
   | _ -> None
 
-
-
 (** This function returns the difference between two runtimes. *)
 and extract_observable runtime runtime' =
   let rec substract new_environment env env' =