This commit is contained in:
Nicolas PENELOUX 2023-12-04 18:05:51 +01:00
parent 3237406430
commit 4805abe904

View file

@ -46,7 +46,42 @@ let check_type_scheme
(HopixTypes.Scheme (ts, HopixTypes.internalize_ty env ty), env)
;;
let synth_literal : HopixAST.literal -> HopixTypes.aty =
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! (check_pattern)"
;;
let rec synth_expression
: HopixTypes.typing_environment -> HopixAST.expression Position.located
-> HopixTypes.aty
=
fun env Position.{ value = e; position = _ } ->
match e with
| Literal l -> synth_literal l.value
| Variable (id, tlist) -> synth_variable env id tlist
| Tagged (cons, tlist, elist) -> synth_tagged env cons tlist elist
| Apply (elist1, elist2) -> synth_apply env elist1 elist2
| Record (field, tlist) -> synth_record env field tlist
| Fun (FunctionDefinition (def, expr)) -> synth_fun env def expr
| TypeAnnotation (expr, t) -> synth_tannot env expr t
| Field (expr, lbl, tlist) -> synth_field env expr lbl tlist
| Tuple elist -> synth_tuple env elist
| Sequence elist -> synth_sequence env elist
| Define (vdef, expr) -> synth_define env vdef expr
| Ref expr -> synth_ref env expr
| Assign (expr1, expr2) -> synth_assign env expr1 expr2
| Read expr -> synth_read env expr
| Case (expr, branches) -> synth_case env expr branches
| IfThenElse (ecase, eif, eelse) -> synth_ifthenelse env ecase eif eelse
| While (ecase, expr) -> synth_while env ecase expr
| For (id, ecase, expr1, expr2) -> synth_for env id ecase expr1 expr2
and synth_literal : HopixAST.literal -> HopixTypes.aty =
fun l ->
match l with
| LInt _ -> HopixTypes.hint
@ -76,7 +111,16 @@ and synth_apply
: HopixTypes.typing_environment -> expression Position.located
-> expression Position.located -> HopixTypes.aty
=
fun tenv f x -> failwith "Students! This is your job! (synth_apply)"
fun tenv f x -> (*failwith "Students! This is your job! (synth_apply)"*)
let f_type = synth_expression tenv f in
match f_type with
| HopixTypes.ATyArrow (gauche,droit) -> (* a' -> b' *)
(
let x_type = synth_expression tenv x in
check_equal_types x.position gauche x_type; droit
)
| _ -> failwith ""
and synth_record
: HopixTypes.typing_environment
@ -161,40 +205,7 @@ and synth_for
-> expression Position.located -> HopixTypes.aty
=
fun tenv id estart eend expr -> failwith "Students! This is your job! (synth_for)"
;;
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! (check_pattern)"
;;
let rec synth_expression
: HopixTypes.typing_environment -> HopixAST.expression Position.located
-> HopixTypes.aty
=
fun env Position.{ value = e; position = _ } ->
match e with
| Literal l -> synth_literal l.value
| Variable (id, tlist) -> synth_variable env id tlist
| Tagged (cons, tlist, elist) -> synth_tagged env cons tlist elist
| Apply (elist1, elist2) -> synth_apply env elist1 elist2
| Record (field, tlist) -> synth_record env field tlist
| Fun (FunctionDefinition (def, expr)) -> synth_fun env def expr
| TypeAnnotation (expr, t) -> synth_tannot env expr t
| Field (expr, lbl, tlist) -> synth_field env expr lbl tlist
| Tuple elist -> synth_tuple env elist
| Sequence elist -> synth_sequence env elist
| Define (vdef, expr) -> synth_define env vdef expr
| Ref expr -> synth_ref env expr
| Assign (expr1, expr2) -> synth_assign env expr1 expr2
| Read expr -> synth_read env expr
| Case (expr, branches) -> synth_case env expr branches
| IfThenElse (ecase, eif, eelse) -> synth_ifthenelse env ecase eif eelse
| While (ecase, expr) -> synth_while env ecase expr
| For (id, ecase, expr1, expr2) -> synth_for env id ecase expr1 expr2
and check_expression
: HopixTypes.typing_environment -> HopixAST.expression Position.located