diff --git a/flap/src/hopix/hopixInterpreter.ml b/flap/src/hopix/hopixInterpreter.ml index 7f25a5a..9a6f500 100644 --- a/flap/src/hopix/hopixInterpreter.ml +++ b/flap/src/hopix/hopixInterpreter.ml @@ -387,9 +387,7 @@ 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 + | Variable (id, _) -> variable_value id environment | Tagged (constructor, _, list_t) -> (* On ignore le type car on interprète *) VTagged (constructor.value, List.map (expression' environment memory) list_t) @@ -397,40 +395,21 @@ and expression pos environment memory = function VRecord (List.map (pair_labels_gvalue environment memory) labels) | Field (expr, label, _) -> field_value expr label environment memory (* On ignore la liste de type *) - | Tuple [] -> - (* Cas pour le Tuple vide - * Un tuple vide ne contient rien (logique), donc on utilise un VUnit*) + | 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, - * 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. *) - | 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 + | Tuple list_expr -> + tuple_value list_expr environment memory + | Sequence list_expr -> + sequence_value list_expr environment memory + | Define (value_def, expr) -> + define_value value_def expr environment memory | 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) + | Ref ref -> ref_value ref environment memory | Assign (expr1, expr2) -> - 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 *) - | None -> - (* TODO : faire une vrai erreur *) - failwith "erreur") + assign_value expr1 expr2 environment memory; VUnit + | Read read -> read_value read environment memory | Case (expr, branches) -> - (* TODO *) case_value expr branches environment memory | IfThenElse (expr1, expr2, expr3) -> if_then_else_value expr1 expr2 expr3 environment memory @@ -439,6 +418,43 @@ and expression pos environment memory = function | TypeAnnotation _ -> VUnit (* On ignore le type car on interprète *) +(* Variable : On cherche la variable dans l'environnement *) +and variable_value id environment = + Environment.lookup id.position id.value environment + + (* Tuple : On applique à chaque expression de la liste l'opération de calcul de sa valeur *) +and tuple_value list_expr environment memory = + VTuple (List.map (expression' environment memory) list_expr) + +(* Sequence : on evalue chaque expression, + * 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. *) +and sequence_value list_expr environment memory = + let vs = List.map (expression' environment memory) list_expr in + List.hd (List.rev vs) + +(*Define : On évalue la définition local puis on en fait un nouveau runtime et on calcule la valeur de l'expression. *) +and define_value value_def expr environment memory = + let runtime = value_definition { environment; memory } value_def in + expression' runtime.environment runtime.memory expr + +(* Reference : On alloue de la mémoire pour le résultat du calcul de l'expression *) +and ref_value ref environment memory = + let dref = expression' environment memory ref in + VLocation (Memory.allocate memory Mint.one dref) + +(* Lecture : On va lire l'espace mémoire *) +and read_value read environment memory = + 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 *) + | None -> error [position read] "Erreur read") + +(* Case : On effectue le pattern matching des branches associés à notre case, + * et on renvoie l'environnement modifié après avoir calculer toute les branches. *) and case_value expr branches environment memory = (* On calcule d'abord l'expression *) let expr' = expression' environment memory expr in @@ -462,7 +478,7 @@ and case_value expr branches environment memory = | [] -> error [ expr.position ] "erreur" | _ as env -> List.hd env - + (* For : On va calculer les valeurs de l'expression (ici expr3) à chaque itération de la boucle *) 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 @@ -501,9 +517,9 @@ and assign_calcul environment memory expr2 v = 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 +(*While : Tant que la condition (valeur de l'expression 1) est true, alors on calcule l'expression de expression 2 + Sinon, on renvoie un VUnit, qui va stopper le processus d'interprétation pour While. *) and while_value expr1 expr2 environment memory pos = let cond = expression' environment memory expr1 in (* On récupère la valeur de la condition *) @@ -513,6 +529,8 @@ and while_value expr1 expr2 environment memory pos = expression pos environment memory (While (expr1, expr2)) | false -> VUnit +(* IfThenELse : Comme pour While, on regarde si la condition est vrai, si c'est le cas, + alors on calcule l'expression du "then", sinon celle du "else" *) 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 *) @@ -522,14 +540,18 @@ and if_then_else_value expr1 expr2 expr3 environment memory = (* Si c'est true, alors on évalue la première expression *) | false -> expression' environment memory expr3 (* sinon la deuxième *) + (* Record : on calcule l'expression, et on associe à chaque élément de la liste la valeur du label *) 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 + (* Fonction annexe qui renverra une paire label * valeur de expression *) +and pair_labels_gvalue environment memory (lab, expr) = + Position.value lab, expression' environment memory expr + +(* Apply : on applique la fonction f à x en fonction des différents cas possibles *) and apply_expression f x environment memory = let x_val = expression' environment memory x in match expression' environment memory f with @@ -545,12 +567,19 @@ and apply_expression f x environment memory = | None -> failwith "erreur") | _ -> assert false (* By typing *) +(* Littéraux *) and literal_expression = function | LInt n -> VInt n | LChar c -> VChar c | LString s -> VString s -(* On match le pattern et expression en même temps *) + + + + +(* --------------- PATTERN MATCHING ----------------- *) + + and pattern environment pat expression = match pat, expression with | PWildcard, _ -> wildcard_pattern environment @@ -566,47 +595,32 @@ and pattern environment pat expression = | PAnd pl, _ -> and_pattern environment pl expression | _ -> None -and wildcard_pattern environment = Some environment +(* PWildcard : on renvoie l'environnement sans modification *) +and wildcard_pattern environment = Some environment +(* PVariable : On bind la valeur de la variable ) l'expression dans l'environnement *) and variable_pattern var env expression = Some (Environment.bind env var.value expression) +(* PTypeAnnotation : On calcule le pattern à son tour *) 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 = p.value 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 = 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 = - if List.length tab = List.length tab2 - then ( - match tab, tab2 with - | [], [] -> Some environment - | pat :: tab', expr :: tab2' -> - let valeur_pattern = pat.value in - (match pattern environment valeur_pattern expr with - | Some env' -> tuple_pattern env' tab' tab2' - | None -> None) - | _ -> None) - else None +(* PLiteral : On regarde si la valeur du pattern correspond à celle de l'expression *) +and literal_pattern pl environment expression = + let valeur_literal = pl.value in + let verif_literal l1 l2 = if l1 = l2 then Some environment else None in + 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 + | _ -> None + (* PTagged : On regarde si les deux constructeurs sont égaux, si c'est le cas on calcule + comme si c'était un PTuple, les deux listes de patterns que nous avons *) and tagged_pattern cons1 cons2 pattern1 pattern2 environment = if cons1.value = cons2 then tuple_pattern environment pattern1 pattern2 else None - + (*PRecord On compare les deux records, on essaye de trouver un match pour chaque field + (du premier record) dans le deuxième record, si c'est le cas on met à jour l'env, sinon + On regarde le prochain élément. *) and record_pattern environment r r' = - match r with | [] -> Some environment | field :: reste -> @@ -627,15 +641,52 @@ and record_pattern environment r r' = else record_labbel_pattern environment field reste +(* PTuple : On a deux tuples, qui pour chaque pair d'éléments effectue un pattern matching, et +renvoie le nouvel environnement *) +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 = pat.value in + (match pattern environment valeur_pattern expr with + | Some env' -> tuple_pattern env' tab' tab2' + | None -> None) + | _ -> None) + else None + +(* POr : Renvoie le nouvelle environnement si au moins un des patterns match avec l'expression*) +and or_pattern env pl expression = + match pl with + | [] -> None + | p :: pl' -> + let valeur_pattern = p.value in + (match pattern env valeur_pattern expression with + | Some env' -> Some env' + | None -> or_pattern env pl' expression) + + (* PAnd : de même, mais chaque élément de la liste des patterns doivent matchs avec l'expression*) +and and_pattern env pl expression = + match pl with + | [] -> Some env + | p :: pl' -> + let valeur_pattern = p.value in + (match pattern env valeur_pattern expression with + | None -> None + | Some env' -> and_pattern env' pl' expression) + + + + + + + + + + + -and literal_pattern pl environment expression = - let valeur_literal = pl.value in - let verif_literal l1 l2 = if l1 = l2 then Some environment else None in - 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 - | _ -> None (** This function returns the difference between two runtimes. *) and extract_observable runtime runtime' = diff --git a/flap/tests/Makefile b/flap/tests/Makefile index 4a5fd80..88bab79 100644 --- a/flap/tests/Makefile +++ b/flap/tests/Makefile @@ -1,7 +1,8 @@ FLAP?=../_build/default/src/flap.exe JALONS=\ 01-Parsing.results \ - 01-Parsing-no-positions.results + 01-Parsing-no-positions.results \ + 02-Interpreter.results EXTS=parsing.hopix parsing-no-positions.hopix .PHONY: all clean test FAKE