This commit is contained in:
Mylloon 2023-11-20 04:43:27 +01:00
parent 099ac3a73d
commit 195139e058
Signed by: Anri
GPG key ID: A82D63DFF8D1317F

View file

@ -5,98 +5,96 @@ open HopixAST
(** Error messages *) (** Error messages *)
let invalid_instantiation pos given expected = let invalid_instantiation pos given expected =
HopixTypes.type_error pos ( HopixTypes.type_error
Printf.sprintf pos
"Invalid number of types in instantiation: \ (Printf.sprintf
%d given while %d were expected." given expected "Invalid number of types in instantiation: %d given while %d were expected."
) given
expected)
;;
let check_equal_types pos ~expected ~given = let check_equal_types pos ~expected ~given =
if expected <> given if expected <> given
then then
HopixTypes.(type_error pos HopixTypes.(
Printf.(sprintf type_error
pos
Printf.(
sprintf
"Type mismatch.\nExpected:\n %s\nGiven:\n %s" "Type mismatch.\nExpected:\n %s\nGiven:\n %s"
(string_of_aty expected) (string_of_aty expected)
(string_of_aty given))) (string_of_aty given)))
;;
(** Linearity-checking code for patterns *) (** Linearity-checking code for patterns *)
let rec check_pattern_linearity let rec check_pattern_linearity
: identifier list -> pattern Position.located -> identifier list : identifier list -> pattern Position.located -> identifier list
= fun vars Position.{ value; position; } -> =
failwith "Students! This is your job!" fun vars Position.{ value; position } -> failwith "Students! This is your job!"
;;
(** Type-checking code *) (** Type-checking code *)
let check_type_scheme : let check_type_scheme
HopixTypes.typing_environment -> : HopixTypes.typing_environment -> Position.t -> HopixAST.type_scheme
Position.t -> -> HopixTypes.aty_scheme * HopixTypes.typing_environment
HopixAST.type_scheme -> =
HopixTypes.aty_scheme * HopixTypes.typing_environment fun env pos (ForallTy (ts, ty)) -> failwith "Students! This is your job!"
= fun env pos (ForallTy (ts, ty)) -> ;;
failwith "Students! This is your job!"
let synth_literal : HopixAST.literal -> HopixTypes.aty = let synth_literal : HopixAST.literal -> HopixTypes.aty =
fun l -> fun l -> failwith "Students! This is your job!"
;;
let rec check_pattern
: HopixTypes.typing_environment -> HopixAST.pattern Position.located -> HopixTypes.aty
-> HopixTypes.typing_environment
=
fun env Position.({ value = p; position = pos } as pat) expected ->
failwith "Students! This is your job!" failwith "Students! This is your job!"
let rec check_pattern : and synth_pattern
HopixTypes.typing_environment -> : HopixTypes.typing_environment -> HopixAST.pattern Position.located
HopixAST.pattern Position.located -> -> HopixTypes.aty * HopixTypes.typing_environment
HopixTypes.aty -> =
HopixTypes.typing_environment fun env Position.{ value = p; position = pos } -> failwith "Students! This is your job!"
= fun env Position.({ value = p; position = pos; } as pat) expected -> ;;
let rec synth_expression
: HopixTypes.typing_environment -> HopixAST.expression Position.located
-> HopixTypes.aty
=
fun env Position.{ value = e; position = pos } -> failwith "Students! This is your job!"
and check_expression
: HopixTypes.typing_environment -> HopixAST.expression Position.located
-> HopixTypes.aty -> unit
=
fun env (Position.{ value = e; position = pos } as exp) expected ->
failwith "Students! This is your job!" failwith "Students! This is your job!"
and synth_pattern : and check_value_definition
HopixTypes.typing_environment -> : HopixTypes.typing_environment -> HopixAST.value_definition
HopixAST.pattern Position.located -> -> HopixTypes.typing_environment
HopixTypes.aty * HopixTypes.typing_environment =
= fun env Position.{ value = p; position = pos; } -> fun env def -> failwith "Students! This is your job!"
failwith "Students! This is your job!" ;;
let rec synth_expression :
HopixTypes.typing_environment ->
HopixAST.expression Position.located ->
HopixTypes.aty
= fun env Position.{ value = e; position = pos; } ->
failwith "Students! This is your job!"
and check_expression :
HopixTypes.typing_environment ->
HopixAST.expression Position.located ->
HopixTypes.aty ->
unit
= fun env (Position.{ value = e; position = pos; } as exp) expected ->
failwith "Students! This is your job!"
and check_value_definition :
HopixTypes.typing_environment ->
HopixAST.value_definition ->
HopixTypes.typing_environment
= fun env def ->
failwith "Students! This is your job!"
let check_definition env = function let check_definition env = function
| DefineValue vdef -> | DefineValue vdef -> check_value_definition env vdef
check_value_definition env vdef
| DefineType (t, ts, tdef) -> | DefineType (t, ts, tdef) ->
let ts = List.map Position.value ts in let ts = List.map Position.value ts in
HopixTypes.bind_type_definition (Position.value t) ts tdef env HopixTypes.bind_type_definition (Position.value t) ts tdef env
| DeclareExtern (x, tys) -> | DeclareExtern (x, tys) ->
let tys, _ = Position.located_pos (check_type_scheme env) tys in let tys, _ = Position.located_pos (check_type_scheme env) tys in
HopixTypes.bind_value (Position.value x) tys env HopixTypes.bind_value (Position.value x) tys env
;;
let typecheck env program = let typecheck env program =
List.fold_left List.fold_left (fun env d -> Position.located (check_definition env) d) env program
(fun env d -> Position.located (check_definition env) d) ;;
env program
type typing_environment = HopixTypes.typing_environment type typing_environment = HopixTypes.typing_environment
let initial_typing_environment = HopixTypes.initial_typing_environment let initial_typing_environment = HopixTypes.initial_typing_environment
let print_typing_environment = HopixTypes.string_of_typing_environment let print_typing_environment = HopixTypes.string_of_typing_environment