remove old cases in transpiler
This commit is contained in:
parent
d44b5a7af0
commit
705c29aeed
@ -42,14 +42,6 @@ them. please report this to the developers." in
|
|||||||
] in
|
] in
|
||||||
error ~data title content
|
error ~data title content
|
||||||
|
|
||||||
let unsupported_iterator location =
|
|
||||||
let title () = "unsupported iterator" in
|
|
||||||
let content () = "only lambda are supported as iterators" in
|
|
||||||
let data = [
|
|
||||||
row_loc location ;
|
|
||||||
] in
|
|
||||||
error ~data title content
|
|
||||||
|
|
||||||
let not_functional_main location =
|
let not_functional_main location =
|
||||||
let title () = "not functional main" in
|
let title () = "not functional main" in
|
||||||
let content () = "main should be a function" in
|
let content () = "main should be a function" in
|
||||||
@ -511,28 +503,14 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
|
|||||||
return @@ E_record_update (record, path, update)
|
return @@ E_record_update (record, path, update)
|
||||||
| E_constant {cons_name=name; arguments=lst} -> (
|
| E_constant {cons_name=name; arguments=lst} -> (
|
||||||
let iterator_generator iterator_name =
|
let iterator_generator iterator_name =
|
||||||
let lambda_to_iterator_body (f : AST.expression) (l : AST.lambda) =
|
|
||||||
let%bind body' = transpile_annotated_expression l.result in
|
|
||||||
let%bind (input , _) = AST.get_t_function f.type_expression in
|
|
||||||
let%bind input' = transpile_type input in
|
|
||||||
ok ((l.binder , input') , body')
|
|
||||||
in
|
|
||||||
let expression_to_iterator_body (f : AST.expression) =
|
let expression_to_iterator_body (f : AST.expression) =
|
||||||
match f.expression_content with
|
let%bind (input , output) = AST.get_t_function f.type_expression in
|
||||||
| E_lambda l -> lambda_to_iterator_body f l
|
let%bind f' = transpile_annotated_expression f in
|
||||||
| E_variable v -> (
|
let%bind input' = transpile_type input in
|
||||||
let%bind elt =
|
let%bind output' = transpile_type output in
|
||||||
trace_option (corner_case ~loc:__LOC__ "missing var") @@
|
let binder = Var.fresh ~name:"iterated" () in
|
||||||
AST.Environment.get_opt v f.environment in
|
let application = Mini_c.Combinators.e_application f' output' (Mini_c.Combinators.e_var binder input') in
|
||||||
match elt.definition with
|
ok ((binder , input'), application)
|
||||||
| ED_declaration { expr = f ; free_variables = _ } -> (
|
|
||||||
match f.expression_content with
|
|
||||||
| E_lambda l -> lambda_to_iterator_body f l
|
|
||||||
| _ -> fail @@ unsupported_iterator f.location
|
|
||||||
)
|
|
||||||
| _ -> fail @@ unsupported_iterator f.location
|
|
||||||
)
|
|
||||||
| _ -> fail @@ unsupported_iterator f.location
|
|
||||||
in
|
in
|
||||||
fun (lst : AST.expression list) -> match (lst , iterator_name) with
|
fun (lst : AST.expression list) -> match (lst , iterator_name) with
|
||||||
| [f ; i] , C_ITER | [f ; i] , C_MAP -> (
|
| [f ; i] , C_ITER | [f ; i] , C_MAP -> (
|
||||||
|
@ -183,6 +183,15 @@ let e_let_in ?loc v tv inline expr body : expression = Expression.(make_tpl ?loc
|
|||||||
E_let_in ((v , tv) , inline, expr , body) ,
|
E_let_in ((v , tv) , inline, expr , body) ,
|
||||||
get_type body
|
get_type body
|
||||||
))
|
))
|
||||||
|
let e_application ?loc f t arg: expression = Expression.(make_tpl ?loc(
|
||||||
|
E_application (f,arg) ,
|
||||||
|
t
|
||||||
|
))
|
||||||
|
let e_var ?loc vname t: expression = Expression.(make_tpl ?loc(
|
||||||
|
E_variable vname ,
|
||||||
|
t
|
||||||
|
))
|
||||||
|
|
||||||
|
|
||||||
let ez_e_sequence ?loc a b : expression = Expression.(make_tpl (E_sequence (make_tpl ?loc (a , t_unit ()) , b) , get_type b))
|
let ez_e_sequence ?loc a b : expression = Expression.(make_tpl (E_sequence (make_tpl ?loc (a , t_unit ()) , b) , get_type b))
|
||||||
|
|
||||||
|
@ -78,3 +78,5 @@ val d_unit : value
|
|||||||
|
|
||||||
val environment_wrap : environment -> environment -> environment_wrap
|
val environment_wrap : environment -> environment -> environment_wrap
|
||||||
val id_environment_wrap : environment -> environment_wrap
|
val id_environment_wrap : environment -> environment_wrap
|
||||||
|
val e_var : ?loc:Location.t -> var_name -> type_expression -> expression
|
||||||
|
val e_application : ?loc:Location.t -> expression -> type_expression -> expression -> expression
|
||||||
|
Loading…
Reference in New Issue
Block a user