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
|
||||
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 title () = "not functional main" 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)
|
||||
| E_constant {cons_name=name; arguments=lst} -> (
|
||||
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) =
|
||||
match f.expression_content with
|
||||
| E_lambda l -> lambda_to_iterator_body f l
|
||||
| E_variable v -> (
|
||||
let%bind elt =
|
||||
trace_option (corner_case ~loc:__LOC__ "missing var") @@
|
||||
AST.Environment.get_opt v f.environment in
|
||||
match elt.definition with
|
||||
| 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
|
||||
let%bind (input , output) = AST.get_t_function f.type_expression in
|
||||
let%bind f' = transpile_annotated_expression f in
|
||||
let%bind input' = transpile_type input in
|
||||
let%bind output' = transpile_type output in
|
||||
let binder = Var.fresh ~name:"iterated" () in
|
||||
let application = Mini_c.Combinators.e_application f' output' (Mini_c.Combinators.e_var binder input') in
|
||||
ok ((binder , input'), application)
|
||||
in
|
||||
fun (lst : AST.expression list) -> match (lst , iterator_name) with
|
||||
| [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) ,
|
||||
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))
|
||||
|
||||
|
@ -78,3 +78,5 @@ val d_unit : value
|
||||
|
||||
val environment_wrap : environment -> 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