diff --git a/flap/src/hopix/hopixTypechecker.ml b/flap/src/hopix/hopixTypechecker.ml index 7f6a001..5f0c30d 100644 --- a/flap/src/hopix/hopixTypechecker.ml +++ b/flap/src/hopix/hopixTypechecker.ml @@ -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