This commit is contained in:
Galfour 2019-05-17 16:18:03 +00:00
parent a94bf665f3
commit ccdbd5bbd0
3 changed files with 16 additions and 8 deletions

View File

@ -62,7 +62,7 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
match v.value.args with match v.value.args with
None -> [] None -> []
| Some (_, product) -> | Some (_, product) ->
npsseq_to_list product.value in npseq_to_list product.value in
let%bind te = simpl_list_type_expression let%bind te = simpl_list_type_expression
@@ args in @@ args in
ok (v.value.constr.value, te) ok (v.value.constr.value, te)

View File

@ -250,9 +250,8 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re
| E_application ({expression = E_lambda {binder; input_type; output_type=_; body=[]; result}; _}, | E_application ({expression = E_lambda {binder; input_type; output_type=_; body=[]; result}; _},
rhs) -> rhs) ->
let%bind ty' = translate_type input_type in let%bind ty' = translate_type input_type in
let%bind rhs' = translate_annotated_expression env rhs in let%bind rhs' = translate_annotated_expression rhs in
let result_env = Environment.(add (binder, ty') env) in let%bind result' = translate_annotated_expression result in
let%bind result' = translate_annotated_expression result_env result in
return (E_let_in ((binder, ty'), rhs', result')) return (E_let_in ((binder, ty'), rhs', result'))
| E_failwith ae -> ( | E_failwith ae -> (
let%bind ae' = translate_annotated_expression ae in let%bind ae' = translate_annotated_expression ae in

View File

@ -489,13 +489,22 @@ and type_annotated_expression : environment -> I.annotated_expression -> O.annot
output_type ; output_type ;
result ; result ;
body ; body ;
} -> } -> (
let%bind input_type = evaluate_type e input_type in let%bind input_type =
let%bind output_type = evaluate_type e output_type in let%bind input_type =
trace_option (simple_error "missing annotation on input type")
input_type in
evaluate_type e input_type in
let%bind output_type =
let%bind output_type =
trace_option (simple_error "missing annotation of output type")
output_type in
evaluate_type e output_type in
let e' = Environment.add_ez_binder binder input_type e in let e' = Environment.add_ez_binder binder input_type e in
let%bind (body, e'') = type_block_full e' body in let%bind (body, e'') = type_block_full e' body in
let%bind result = type_annotated_expression e'' result in let%bind result = type_annotated_expression e'' result in
return (E_lambda {binder;input_type;output_type;result;body}) (t_function input_type output_type ()) return (E_lambda {binder;input_type;output_type;result;body}) (t_function input_type output_type ())
)
| E_constant (name, lst) -> | E_constant (name, lst) ->
let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in
let tv_lst = List.map get_type_annotation lst' in let tv_lst = List.map get_type_annotation lst' in
@ -636,7 +645,7 @@ let rec untype_annotated_expression (e:O.annotated_expression) : (I.annotated_ex
let%bind output_type = untype_type_value output_type in let%bind output_type = untype_type_value output_type in
let%bind result = untype_annotated_expression result in let%bind result = untype_annotated_expression result in
let%bind body = untype_block body in let%bind body = untype_block body in
return (E_lambda {binder;input_type;output_type;body;result}) return (E_lambda {binder;input_type = Some input_type;output_type = Some output_type;body;result})
| E_tuple lst -> | E_tuple lst ->
let%bind lst' = bind_list let%bind lst' = bind_list
@@ List.map untype_annotated_expression lst in @@ List.map untype_annotated_expression lst in