This commit is contained in:
Mylloon 2023-11-12 19:30:41 +01:00
parent aec53f30e1
commit 5f2c67b1b3
Signed by: Anri
GPG key ID: A82D63DFF8D1317F

View file

@ -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) ->
(* case_value expr branch environment memory *)
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
@ -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
match v with
| *)
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