From 5f2c67b1b3c264d1588f2695f6092c91956dc8cc Mon Sep 17 00:00:00 2001 From: Mylloon Date: Sun, 12 Nov 2023 19:30:41 +0100 Subject: [PATCH] 67/72 --- flap/src/hopix/hopixInterpreter.ml | 89 ++++++++++++++++++------------ 1 file changed, 54 insertions(+), 35 deletions(-) diff --git a/flap/src/hopix/hopixInterpreter.ml b/flap/src/hopix/hopixInterpreter.ml index c3f4673..38c8cc9 100644 --- a/flap/src/hopix/hopixInterpreter.ml +++ b/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") - (* TODO : faire une vrai erreur *) - | Case (expr, branch) -> - (* case_value expr branch environment memory *) + | None -> + (* TODO : faire une vrai erreur *) + failwith "erreur") + | 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 @@ -439,12 +439,31 @@ and expression pos environment memory = function | TypeAnnotation _ -> VUnit (* On ignore le type car on interprète *) -(* TODO a finir (à commencer plutôt)*) -(* and case_value expr branch environment memory = - (* On calcule d'abord l'expression *) - let v = expression' environment memory expr in - match v with - | *) +(* TODO a finir (à commencer plutôt) *) +and case_value expr branches environment memory = + (* On calcule d'abord l'expression *) + let expr' = expression' environment memory expr in + (* 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 - | 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 + | PWildcard, _ -> wildcard_pattern environment + | PLiteral lit, _ -> literal_pattern lit environment expression + | PVariable var, _ -> variable_pattern var environment expression + | PTypeAnnotation (pattern', _), _ -> + typeannot_pattern pattern'.value environment 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 - if valeur_cons1 = cons2 then tuple_pattern environment pattern1 pattern2 else None + (* BOUCLE INFINIE ??? *) + if cons1.value = cons2 then tuple_pattern environment pattern1 pattern2 else None -(* - and variable_pattern environment var expression = - let valeur_var = value var in - Some(Environment.bind environment var expression) -*) +and record_pattern environment r r' = + (* TODO *) + None 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