fix
This commit is contained in:
parent
a94bf665f3
commit
ccdbd5bbd0
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user