Paris7/compilation
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Activity

type checking

Browse source
This commit is contained in:
Mylloon 2023-12-04 18:33:56 +01:00
parent a01eba04e3
commit 1edd925ed5
Signed by: Anri
GPG key ID: A82D63DFF8D1317F
1 changed files with 8 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
flap/src/hopix/hopixTypechecker.ml
View file

@ -2,6 +2,8 @@
open HopixAST open HopixAST
let get_aty (HopixTypes.Scheme (_, aty_value)) : HopixTypes.aty = aty_value
(** Error messages *) (** Error messages *)
let invalid_instantiation pos given expected = let invalid_instantiation pos given expected =
@ -203,7 +205,9 @@ and check_expression
fun env (Position.{ value = e; position = pos } as exp) expected -> fun env (Position.{ value = e; position = pos } as exp) expected ->
match e with match e with
| Fun df -> failwith "Students! This is your job! Fun check" | Fun df -> failwith "Students! This is your job! Fun check"
| _ -> failwith "Students! This is your job! check_expression wildcard" | _ ->
let given = synth_expression env exp in
check_equal_types pos ~expected ~given
and check_value_definition and check_value_definition
: HopixTypes.typing_environment -> HopixAST.value_definition : HopixTypes.typing_environment -> HopixAST.value_definition
@ -212,10 +216,11 @@ and check_value_definition
fun env -> function fun env -> function
| SimpleValue (id, ty, ex) -> | SimpleValue (id, ty, ex) ->
(match ty with (match ty with
| None -> failwith "Type missing." | None -> failwith "A type is missing."
| Some ty' -> | Some ty' ->
(*failwith "Students! This is your job! (check_value_definition | SimpleValue)"*) (*failwith "Students! This is your job! (check_value_definition | SimpleValue)"*)
let tys, _ = Position.located_pos (check_type_scheme env) ty' in let tys, tenv = Position.located_pos (check_type_scheme env) ty' in
check_expression tenv ex (get_aty tys);
HopixTypes.bind_value (Position.value id) tys env) HopixTypes.bind_value (Position.value id) tys env)
| RecFunctions _ -> | RecFunctions _ ->
(* Je crois que c'est galère et donc c'est pas grave si on arrive pas (* Je crois que c'est galère et donc c'est pas grave si on arrive pas