fmt
This commit is contained in:
parent
099ac3a73d
commit
195139e058
1 changed files with 66 additions and 68 deletions
|
@ -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
|
||||||
|
|
Reference in a new issue