From a3c305fb9cee2e8c07760589ac7d25060f6290e0 Mon Sep 17 00:00:00 2001 From: Nicolas PENELOUX Date: Sat, 11 Nov 2023 21:49:31 +0100 Subject: [PATCH] 48/72, fix Assign, Apply, add pattern for Wildcard / Literal / Variable / TypeAnnotation / Tagged / Tuple / Or & And --- flap/src/hopix/hopixInterpreter.ml | 136 +++++++++++++++++++---------- 1 file changed, 91 insertions(+), 45 deletions(-) diff --git a/flap/src/hopix/hopixInterpreter.ml b/flap/src/hopix/hopixInterpreter.ml index 49c4006..98177e1 100644 --- a/flap/src/hopix/hopixInterpreter.ml +++ b/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*) - failwith ("todo") + | Assign(expr1,expr2) -> + (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 - | Some(m) -> Memory.write (m) (Mint.zero) (value) - | _ -> failwith "erreur"*) + Memory.write mem Mint.zero value + @@ -541,15 +533,13 @@ and apply_expression f x environment memory = | VPrimitive (_, f) -> (* Fonction "primitive" *) f memory x_val - | VClosure (_env_fn, _pattern, _expr) ->(* - - let pat = pattern _env_fn (value pattern) x_val in (*Pattern va nous calculer un nouvelle environnement*) + | 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*) match pat with - | Some(env') -> expression' env' memory expression - | None -> failwith ("erreur")*) - (* Fonction - * TODO: Pattern matching ici *) - failwith "Students! This is your job (Apply)!" + | Some(env') -> expression' env' memory _expr + | None -> failwith ("erreur")) + | _ -> 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 = - match pattern, expression with - | PLiteral pl, _ -> literal_pattern pl - | 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 variable_pattern environment var expression = + let valeur_var = value var in + Some(Environment.bind environment var expression) *) +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' =