multiple parameters allegedly work
This commit is contained in:
parent
2ae73f80a9
commit
7f52774c06
@ -85,10 +85,18 @@ let transpile (p:AST_Typed.program) : Mini_c.program result = Transpiler.transla
|
||||
let transpile_entry (p:AST_Typed.program) (name:string) : Mini_c.anon_function result = Transpiler.translate_entry p name
|
||||
let transpile_expression ?(env:Mini_c.Environment.t = Mini_c.Environment.empty)
|
||||
(e:AST_Typed.annotated_expression) : Mini_c.expression result = Transpiler.translate_annotated_expression env e
|
||||
let transpile_value ?(env:Mini_c.Environment.t = Mini_c.Environment.empty)
|
||||
let transpile_value
|
||||
(e:AST_Typed.annotated_expression) : Mini_c.value result =
|
||||
let%bind e = Transpiler.translate_annotated_expression env e in
|
||||
Mini_c.expression_to_value e
|
||||
let%bind f =
|
||||
let open Transpiler in
|
||||
let (f, t) = functionalize e in
|
||||
let%bind main = translate_main f t in
|
||||
ok main
|
||||
in
|
||||
|
||||
let input = Mini_c.Combinators.d_unit in
|
||||
let%bind r = Mini_c.Run.run_entry f input in
|
||||
ok r
|
||||
|
||||
let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result =
|
||||
Transpiler.untranspile v e
|
||||
@ -110,11 +118,12 @@ let type_file ?(debug_simplify = false) ?(debug_typed = false)
|
||||
)) ;
|
||||
ok typed
|
||||
|
||||
|
||||
let easy_run_typed
|
||||
?(debug_mini_c = false) (entry:string)
|
||||
(program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
|
||||
let%bind mini_c_main =
|
||||
trace (simple_error "transpile mini_c main") @@
|
||||
trace (simple_error "transpile mini_c entry") @@
|
||||
transpile_entry program entry in
|
||||
(if debug_mini_c then
|
||||
Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main.content)
|
||||
|
@ -187,13 +187,6 @@ module PP = struct
|
||||
fprintf ppf "Program:\n---\n%a" (pp_print_list ~pp_sep:pp_print_newline tl_statement) p
|
||||
end
|
||||
|
||||
let expression_to_value ((e', _, _) as e:expression) : value result =
|
||||
match e' with
|
||||
| Literal v -> ok v
|
||||
| _ -> fail
|
||||
@@ error "not a value"
|
||||
@@ Format.asprintf "%a" PP.expression e
|
||||
|
||||
module Free_variables = struct
|
||||
type free_variable = string
|
||||
type free_variables = free_variable list
|
||||
@ -1001,6 +994,14 @@ module Run = struct
|
||||
let%bind (result : value) = Translate_ir.translate_value ex_ty_value in
|
||||
ok result
|
||||
|
||||
|
||||
let expression_to_value ((e', _, _) as e:expression) : value result =
|
||||
match e' with
|
||||
| Literal v -> ok v
|
||||
| _ -> fail
|
||||
@@ error "not a value"
|
||||
@@ Format.asprintf "%a" PP.expression e
|
||||
|
||||
end
|
||||
|
||||
|
||||
@ -1077,6 +1078,8 @@ module Combinators = struct
|
||||
let expr_int expr env : expression = (expr, t_int, env)
|
||||
let var_int name env : expression = expr_int (Var name) env
|
||||
|
||||
let d_unit : value = `Unit
|
||||
|
||||
let environment_wrap pre_environment post_environment = { pre_environment ; post_environment }
|
||||
let id_environment_wrap e = environment_wrap e e
|
||||
|
||||
|
@ -16,7 +16,8 @@ let rec translate_type (t:AST.type_value) : type_value result =
|
||||
| Type_constant ("bool", []) -> ok (`Base Bool)
|
||||
| Type_constant ("int", []) -> ok (`Base Int)
|
||||
| Type_constant ("string", []) -> ok (`Base String)
|
||||
| Type_constant _ -> simple_fail "unrecognized constant"
|
||||
| Type_constant ("unit", []) -> ok (`Base Unit)
|
||||
| Type_constant (name, _) -> fail (error "unrecognized constant" name)
|
||||
| Type_sum m ->
|
||||
let node = Append_tree.of_list @@ list_of_map m in
|
||||
let aux a b : type_value result =
|
||||
@ -255,6 +256,18 @@ let translate_main (l:AST.lambda) (t:AST.type_value) : anon_function result =
|
||||
| Literal (`Function f) -> ok f
|
||||
| _ -> simple_fail "main is not a function"
|
||||
|
||||
(* From a non-functional expression [expr], build the functional expression [fun () -> expr] *)
|
||||
let functionalize (e:AST.annotated_expression) : AST.lambda * AST.type_value =
|
||||
let t = e.type_annotation in
|
||||
let open! AST in
|
||||
{
|
||||
binder = "_" ;
|
||||
input_type = Combinators.make_t_unit ;
|
||||
output_type = t ;
|
||||
result = e ;
|
||||
body = [Skip]
|
||||
}, Combinators.(make_t_function (make_t_unit, t))
|
||||
|
||||
let translate_entry (lst:AST.program) (name:string) : anon_function result =
|
||||
let rec aux acc (lst:AST.program) =
|
||||
match lst with
|
||||
@ -265,7 +278,9 @@ let translate_entry (lst:AST.program) (name:string) : anon_function result =
|
||||
then (
|
||||
match an.annotated_expression.expression with
|
||||
| Lambda l -> Some (acc, l, an.annotated_expression.type_annotation)
|
||||
| _ -> None
|
||||
| _ ->
|
||||
let (a, b) = functionalize an.annotated_expression in
|
||||
Some (acc, a, b)
|
||||
) else (
|
||||
aux ((AST.Assignment an) :: acc) tl
|
||||
)
|
||||
|
Loading…
Reference in New Issue
Block a user