67/72

flap/src/hopix/hopixInterpreter.ml

@@ -426,12 +426,12 @@ and expression pos environment memory = function
      | Some adr ->
        Memory.read (Memory.dereference memory adr) Mint.zero
        (* On lis la valeur de la mémoire *)
-     | None -> failwith "erreur")
+     | None ->
        (* TODO : faire une vrai erreur *)
-  | Case (expr, branch) ->
+       failwith "erreur")
-    (* case_value expr branch environment memory *)
+  | Case (expr, branches) ->
     (* TODO *)
-    failwith "Students! This is your job (Case)!"
+    case_value expr branches environment memory
   | IfThenElse (expr1, expr2, expr3) ->
     if_then_else_value expr1 expr2 expr3 environment memory
   | While (expr1, expr2) -> while_value expr1 expr2 environment memory pos
@@ -440,11 +440,30 @@ and expression pos environment memory = function
 (* 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 branches environment memory =
   (* On calcule d'abord l'expression *)
-   let v = expression' environment memory expr in
+  let expr' = expression' environment memory expr in
-   match v with
+  (* On évalue les branches *)
-   | *)
+  let branches' =
+    List.fold_left
+      (fun acc branch ->
+        match acc with
+        | [] ->
+          (* Faut évaluer la branche avec l'expression *)
+          let (Branch (pat, branch')) = branch.value in
+          (match pattern environment pat.value expr' with
+           | Some env -> [ expression' env memory branch' ]
+           | None -> [])
+        | _ -> acc)
+      []
+      branches
+  in
+  (* On fait le match avec ce qu'on a comme info *)
+  match branches' with
+  | [] ->
+    (* TODO *)
+    error [] "error"
+  | _ as env -> List.hd env
 
 and for_value id expr1 expr2 expr3 environment memory =
   let borne_inf = value_as_int (expression' environment memory expr1) in
@@ -456,7 +475,7 @@ and for_value id expr1 expr2 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
      en augmentant l'indice de la borne inférieur de 1 à chaque appelle. *)
-  | _ -> error [ position expr1; position expr2 ] "erreur"
+  | _ -> error [ expr1.position; expr2.position ] "erreur"
 
 and boucle_for id borne_inf borne_sup expr3 environment memory =
   if borne_inf <= borne_sup (* Cas où nous sommes dans la boucle *)
@@ -476,7 +495,7 @@ 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"
+  | None -> error [ expr1.position; expr2.position ] "erreur assign"
   | Some v -> assign_calcul environment memory expr2 v
 
 and assign_calcul environment memory expr2 v =
@@ -520,7 +539,7 @@ and apply_expression f x environment memory =
     (* Fonction "primitive" *)
     f memory x_val
   | VClosure (_env_fn, _pattern, _expr) ->
-    let valeur_pattern = value _pattern in
+    let valeur_pattern = _pattern.value in
     let pat = pattern _env_fn valeur_pattern x_val in
     (* Pattern va nous calculer un nouvelle environnement *)
     (match pat with
@@ -536,47 +555,49 @@ and literal_expression = function
 (* On match le pattern et expression en même temps *)
 and pattern environment pat expression =
   match pat, expression with
-  | PWildcard, _ -> Some environment
+  | PWildcard, _ -> wildcard_pattern environment
-  | PLiteral pl, _ -> literal_pattern pl environment expression
+  | PLiteral lit, _ -> literal_pattern lit environment expression
-  | PVariable var, _ -> Some (Environment.bind environment (value var) expression)
+  | PVariable var, _ -> variable_pattern var environment expression
-  | PTypeAnnotation (new_pattern, _), _ ->
+  | PTypeAnnotation (pattern', _), _ ->
-    let valeur_pattern = value new_pattern in
+    typeannot_pattern pattern'.value environment expression
-    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"
+  | PRecord (r, _), VRecord r2 -> record_pattern environment r r2
   | PTuple tab, VTuple tab2 -> tuple_pattern environment tab tab2
   | POr pl, _ -> or_pattern environment pl expression
   | PAnd pl, _ -> and_pattern environment pl expression
   | _ -> None
 
-(* On va match les deux listes *)
+and wildcard_pattern environment = Some environment
+and variable_pattern var env expression = Some (Environment.bind env var.value expression)
+and typeannot_pattern pattern' env expression = pattern env pattern' expression
 
 and and_pattern env pl expression =
   match pl with
   | [] -> Some env
   | p :: pl' ->
-    let valeur_pattern = value p in
+    let valeur_pattern = p.value in
     (match pattern env valeur_pattern expression with
      | None -> None
-     | Some env' -> and_pattern env pl' expression)
+     | Some env' -> and_pattern env' pl' expression)
 
 and or_pattern env pl expression =
   match pl with
   | [] -> None
   | p :: pl' ->
-    let valeur_pattern = value p in
+    let valeur_pattern = p.value in
     (match pattern env valeur_pattern expression with
      | Some env' -> Some env'
      | None -> or_pattern env pl' expression)
 
 and tuple_pattern environment tab tab2 =
+  (* BOUCLE INFINIE ??? *)
   if List.length tab = List.length tab2
   then (
     match tab, tab2 with
     | [], [] -> Some environment
     | pat :: tab', expr :: tab2' ->
-      let valeur_pattern = value pat in
+      let valeur_pattern = pat.value in
       (match pattern environment valeur_pattern expr with
        | Some env' -> tuple_pattern env' tab' tab2'
        | None -> None)
@@ -584,19 +605,17 @@ and tuple_pattern environment tab tab2 =
   else None
 
 and tagged_pattern cons1 cons2 pattern1 pattern2 environment =
-  let valeur_cons1 = value cons1 in
+  (* BOUCLE INFINIE ??? *)
-  if valeur_cons1 = cons2 then tuple_pattern environment pattern1 pattern2 else None
+  if cons1.value = cons2 then tuple_pattern environment pattern1 pattern2 else None
 
-(*
+and record_pattern environment r r' =
-   and variable_pattern environment var expression =
+  (* TODO *)
-   let valeur_var = value var in
+  None
-   Some(Environment.bind environment var expression)
-*)
 
 and literal_pattern pl environment expression =
-  let valeur_pl = value pl in
+  let valeur_literal = pl.value in
   let verif_literal l1 l2 = if l1 = l2 then Some environment else None in
-  match valeur_pl, expression with
+  match valeur_literal, 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