diff --git a/flap/src/hopix/hopixTypechecker.ml b/flap/src/hopix/hopixTypechecker.ml index 7bcb070..7a54b9f 100644 --- a/flap/src/hopix/hopixTypechecker.ml +++ b/flap/src/hopix/hopixTypechecker.ml @@ -90,16 +90,17 @@ and synth_pattern : HopixTypes.typing_environment -> HopixAST.pattern Position.located -> HopixTypes.aty * HopixTypes.typing_environment = - fun env Position.{ value = p; position = pos } -> match p with - | PWildcard -> failwith "PWildcard" - | PLiteral l-> failwith "Pliteral" - | PVariable pv -> failwith "PVariable" - | PTypeAnnotation(p,ty) -> failwith "PTypeAnnot" - | PTuple(plist) -> failwith "PTuple" - | POr(plist) -> failwith "POr" - | PAnd (plist) -> failwith "PAnd" - | PTaggedValue(cons,tlist,plist) -> failwith "PTagged" - | PRecord(plist,tlist) -> failwith "PRecord" + fun env Position.{ value = p; position = pos } -> + match p with + | PWildcard -> failwith "synth_pattern | PWildcard" + | PLiteral l -> failwith "synth_pattern | Pliteral" + | PVariable pv -> failwith "synth_pattern | PVariable" + | PTypeAnnotation (p, ty) -> failwith "synth_pattern | PTypeAnnot" + | PTuple plist -> failwith "synth_pattern | PTuple" + | POr plist -> failwith "synth_pattern | POr" + | PAnd plist -> failwith "synth_pattern | PAnd" + | PTaggedValue (cons, tlist, plist) -> failwith "synth_pattern | PTagged" + | PRecord (plist, tlist) -> failwith "synth_pattern | PRecord" and synth_variable : HopixTypes.typing_environment -> identifier Position.located @@ -214,10 +215,10 @@ and synth_fun : HopixTypes.typing_environment -> pattern Position.located -> expression Position.located -> HopixTypes.aty = - fun tenv pat expr -> - let pat_type, tenv = synth_pattern tenv pat in - let expr_type = synth_expression tenv expr in - ATyArrow(pat_type,expr_type) + fun tenv pat expr -> + let pat_type, tenv = synth_pattern tenv pat in + let expr_type = synth_expression tenv expr in + ATyArrow (pat_type, expr_type) and synth_tannot : HopixTypes.typing_environment -> expression Position.located -> ty Position.located @@ -233,15 +234,18 @@ and synth_field : HopixTypes.typing_environment -> expression Position.located -> label Position.located -> ty Position.located list option -> HopixTypes.aty = - fun tenv expr lbl tlist -> failwith "synth_field" (*let expr_type = synth_expression tenv expr in - match expr_type with + fun tenv expr lbl tlist -> + (* TODO *) + failwith "synth_field" +(*let expr_type = synth_expression tenv expr in + match expr_type with | ATyCon(cons,atlist) -> ( (* Impossible car n'est pas dans le mli*) - let lbllist = HopixTypes.lookup_information_of_type_constructor lbl.position cons tenv in - match lbllist with + let lbllist = HopixTypes.lookup_information_of_type_constructor lbl.position cons tenv in + match lbllist with | Record r -> - if List.mem lbl.value r + if List.mem lbl.value r then let label_scheme = try HopixTypes.lookup_type_scheme_of_label label_pos label_val tenv with @@ -251,17 +255,18 @@ and synth_field try HopixTypes.instantiate_type_scheme label_scheme atlist with | HopixTypes.InvalidInstantiation { expected; given } -> invalid_instantiation (Position.position expr) expected given - else + else failwith "Erreur de label" ) | _ -> failwith "Ceci n'est pas un label" *) + and synth_tuple : HopixTypes.typing_environment -> expression Position.located list -> HopixTypes.aty = - fun tenv elist -> let list_type = List.map( - fun x -> synth_expression tenv x - ) elist in HopixTypes.ATyTuple(list_type) + fun tenv elist -> + let list_type = List.map (fun x -> synth_expression tenv x) elist in + HopixTypes.ATyTuple list_type and synth_sequence : HopixTypes.typing_environment -> expression Position.located list -> HopixTypes.aty