2019-09-10 15:19:15 +02:00
|
|
|
open Trace
|
|
|
|
|
2019-11-29 21:22:56 +00:00
|
|
|
let compile (program : Ast_simplified.program) : (Ast_typed.program * Typer.Solver.state) result =
|
2019-10-11 15:21:21 -04:00
|
|
|
let%bind (prog_typed , state) = Typer.type_program program in
|
|
|
|
let () = Typer.Solver.discard_state state in
|
2020-03-02 19:26:23 +01:00
|
|
|
let%bind prog_typed' = Self_ast_typed.all_program prog_typed in
|
|
|
|
ok @@ (prog_typed', state)
|
2019-09-20 18:56:55 +02:00
|
|
|
|
2019-12-12 11:00:04 +01:00
|
|
|
let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression)
|
2019-12-04 18:30:52 +01:00
|
|
|
: (Ast_typed.expression * Typer.Solver.state) result =
|
2020-03-02 19:26:23 +01:00
|
|
|
let%bind (ae_typed,state) = Typer.type_expression_subst env state ae in
|
2019-12-06 16:32:18 +01:00
|
|
|
let () = Typer.Solver.discard_state state in
|
2020-03-02 19:26:23 +01:00
|
|
|
let%bind ae_typed' = Self_ast_typed.all_expression ae_typed in
|
|
|
|
ok @@ (ae_typed',state)
|
2019-12-12 11:00:04 +01:00
|
|
|
|
2019-12-11 19:15:25 +01:00
|
|
|
let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simplified.expression result =
|
|
|
|
let name = Var.of_name entry_point in
|
|
|
|
let entry_point_var : Ast_simplified.expression =
|
2019-12-04 18:30:52 +01:00
|
|
|
{ expression_content = Ast_simplified.E_variable name ;
|
2019-12-11 19:15:25 +01:00
|
|
|
location = Virtual "generated entry-point variable" } in
|
2019-12-04 18:30:52 +01:00
|
|
|
let applied : Ast_simplified.expression =
|
|
|
|
{ expression_content = Ast_simplified.E_application {expr1=entry_point_var; expr2=param} ;
|
2019-12-11 19:15:25 +01:00
|
|
|
location = Virtual "generated application" } in
|
|
|
|
ok applied
|
2020-01-21 12:24:51 +00:00
|
|
|
|
|
|
|
let pretty_print formatter (program : Ast_simplified.program) =
|
2019-12-20 15:52:49 +01:00
|
|
|
Ast_simplified.PP.program formatter program
|
|
|
|
|
|
|
|
let list_declarations (program : Ast_simplified.program) : string list =
|
|
|
|
List.fold_left
|
|
|
|
(fun prev el ->
|
|
|
|
let open Location in
|
|
|
|
let open Ast_simplified in
|
|
|
|
match el.wrap_content with
|
|
|
|
| Declaration_constant (var,_,_,_) -> (Var.to_name var)::prev
|
|
|
|
| _ -> prev)
|
|
|
|
[] program
|