48/72, fix Assign, Apply, add pattern for Wildcard / Literal / Variable / TypeAnnotation / Tagged / Tuple / Or & And

flap/src/hopix/hopixInterpreter.ml

@@ -423,8 +423,8 @@ and expression pos environment memory = function
     let dref = expression' environment memory ref in
     VLocation (Memory.allocate memory Mint.one dref)
 
-  | Assign(expr1,expr2) -> (*assign_value expr1 expr2 environment memory*)
+  | Assign(expr1,expr2) -> 
-  failwith ("todo")
+    (assign_value expr1 expr2 environment memory ; VUnit)
 
   | Read read ->
     let loc = value_as_location (expression' environment memory read) in
@@ -477,29 +477,21 @@ and boucle_for id borne_inf borne_sup expr3 environment memory =
 
   (* 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 =
   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
 
-  (let value = expression' environment memory expr2 in 
-  let mem = Memory.dereference(memory) (v) in
-  Memory.write mem Mint.zero value)
 
-  (*TODO corriger le bug avec UNIT*)
   
 and assign_calcul environment memory expr2 v =
   let value = expression' environment memory expr2 in
   let mem = Memory.dereference memory v in 
-  match mem with
+  Memory.write mem Mint.zero value
-  | Some(m) -> Memory.write (m) (Mint.zero) (value)
+
-  | _ -> failwith "erreur"*)
 
 
 
@@ -541,15 +533,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 (value pattern) x_val in (*Pattern va nous calculer un nouvelle environnement*)
+    let pat = pattern _env_fn valeur_pattern x_val in (*Pattern va nous calculer un nouvelle environnement*)
     match pat with 
-    | Some(env') -> expression' env' memory expression
+    | Some(env') -> expression' env' memory _expr
-    | None -> failwith ("erreur")*)
+    | None -> failwith ("erreur"))
-    (* Fonction
+
-     * TODO: Pattern matching ici *)
-    failwith "Students! This is your job (Apply)!"
   | _ -> assert false (* By typing *)
 
 and literal_expression = function
@@ -558,34 +548,90 @@ and literal_expression = function
   | LString s -> VString s
 
   
-  (*TODO : à la place des TODO, mettre des autres fonctions pour calculer chaque cas*)
+  (*On match le pattern et expression en même temps*)
+and pattern environment pat expression =
+  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 env pl expression
+
+    | _ -> None
+    
+(* On va match les deux listes*)
+
+and and_pattern env pl expression =
+  match pl with
+  | [] -> Some env
+  | p :: pl' ->
+    (let valeur_pattern = value p in
+    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' ->(
+    let valeur_pattern = value p in
+    match pattern env valeur_pattern expression with
+    | Some (env') -> Some (env')
+    | None -> or_pattern env pl' expression
+  )
+
+and tuple_pattern environment tab tab2 = 
+  if List.length tab = List.length tab2 then
+    match tab, tab2 with
+    | [], [] -> Some (environment)
+    | pat::tab', expr::tab2' ->
+      (let valeur_pattern = value pat in
+        match pattern environment valeur_pattern expr with 
+        | Some (env') -> tuple_pattern env' tab' tab2'
+        | None -> None)
+    else None
+
+
+and tagged_pattern cons1 cons2 pattern1 pattern2 environment =
+  let valeur_cons1 = value cons1 in
+  if valeur_cons1 = cons2 then 
+    tuple_pattern environment pattern1 pattern2
+  else None
 
   (*
-and pattern environment pattern expression =
+and variable_pattern environment var expression =
-  match pattern, expression with 
+  let valeur_var = value var in
-    | PLiteral pl, _ -> literal_pattern pl
+  Some(Environment.bind environment var expression)
-    | PWildcard, _ -> environment
-    | PVariable var,_ -> Environment.bind environment var.value expression
-    | PTypeAnnotation(new_pattern,_), _ -> pattern (environment new_pattern expression)
-    | PTaggedValue(cons,_,new_pattern),_ -> (*Erreur ?*)failwith "erreur"
-    | PTaggedValue(cons,_,new_pattern),VTagged(cons2,new_pattern2) -> (* TODO *)failwith "erreur"
-    | PRecord(r,_), _ -> (* Erreur ?*) failwith "erreur"
-    | PRecord(r,_),VRecord(r2) -> (*TODO*)failwith "erreur"
-    | PTuple(tab),_ -> (* Erreur ?*)failwith "erreur"
-    | PTuple(tab),VTuple(tab2) -> (*TODO*)failwith "erreur"
-    (* TODO POr et PAnd en vrai j'ai une idée mais la fatigue me rattrape
-       Je l'écris si jamais quelqu'un d'autre à part moi lis ceci
-       L'idée est de regarde pour POr si dans la liste de pattern, il y a au moins un élément qui match expression
-       PAreil pour And donc mais tout dois match*)
-
-
-and literal_pattern pl = 
-  match pl with 
-  | LInt n -> VInt n
-  | LChar c -> VChar c
-  | LString s -> VString s
 *)
 
+and literal_pattern pl environment expression = 
+  let valeur_pl = value pl in
+  let verif_literal l1 l2 = 
+  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' =