ez run main

src/ligo/ast_typed.ml

@@ -44,19 +44,21 @@ and type_value = {
   simplified : S.type_expression option ;
 }
 
+and lambda = {
+  binder: name ;
+  input_type: tv ;
+  output_type: tv ;
+  result: ae ;
+  body: block ;
+}
+
 and expression =
   (* Base *)
   | Literal of literal
   | Constant of name * ae list (* For language constants, like (Cons hd tl) or (plus i j) *)
   | Variable of name
   | Application of ae * ae
-  | Lambda of {
+  | Lambda of lambda
-      binder: name ;
-      input_type: tv ;
-      output_type: tv ;
-      result: ae ;
-      body: block ;
-    }
   (* Tuple *)
   | Tuple of ae list
   | Tuple_accessor of ae * int (* Access n'th tuple's element *)
@@ -100,8 +102,20 @@ and matching =
     }
   | Match_tuple of name list * b
 
+open! Ligo_helpers.Trace
+
+
 let type_value type_value simplified = { type_value ; simplified }
 let annotated_expression expression type_annotation = { expression ; type_annotation }
+let get_entry (p:program) (entry : string) =
+  let aux (d:declaration) =
+    match d with
+    | Constant_declaration {name ; annotated_expression = {expression = Lambda l ; type_annotation}} when entry = name ->
+        Some (l, type_annotation)
+    | _ -> None
+  in
+  trace_option (simple_error "no entry point with given name")
+  @@ Tezos_utils.List.find_map aux p
 
 module PP = struct
   open Format
@@ -120,7 +134,6 @@ module PP = struct
     type_value' ppf tv.type_value
 end
 
-open! Ligo_helpers.Trace
 
 module Errors = struct
   let different_kinds a b =

src/ligo/ligo.ml

@@ -88,3 +88,21 @@ let transpile_value ?(env:Mini_c.Environment.t = Mini_c.Environment.empty)
 let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result =
   Transpiler.untranspile v e
 
+let easy_run_main (path:string) (input:string) : AST_Typed.annotated_expression result =
+  let%bind raw = parse_file path in
+  let%bind simpl = simplify raw in
+  let%bind typed = type_ simpl in
+  let%bind typed_main = Ast_typed.get_entry typed "main" in
+  let%bind main_result_type = match (snd typed_main).type_value with
+    | Type_function (_, result) -> ok result
+    | _ -> simple_fail "main doesn't have fun type" in
+  let%bind mini_c_main = Transpiler.translate_main (fst typed_main) (snd typed_main) in
+
+  let%bind raw_expr = parse_expression input in
+  let%bind simpl_expr = simplify_expr raw_expr in
+  let%bind typed_expr = type_expression simpl_expr in
+  let%bind mini_c_value = transpile_value typed_expr in
+
+  let%bind mini_c_result = Mini_c.Run.run_entry mini_c_main mini_c_value in
+  let%bind typed_result = untranspile_value mini_c_result main_result_type in
+  ok typed_result

src/ligo/mini_c.ml

@@ -882,12 +882,12 @@ module Translate_program = struct
     body : michelson ;
   }
 
-  let translate (p:program) : compiled_program result =
+  let translate_program (p:program) (entry:string) : compiled_program result =
     let is_main ((s, _):toplevel_statement) = match s with
-      | "main", (Function_expression f, `Function (_, _), _) when f.capture_type = No_capture -> Some f
+      | name , (Function_expression f, `Function (_, _), _) when f.capture_type = No_capture && name = entry -> Some f
       | _ -> None in
     let%bind main =
-      trace_option (simple_error "no functional main") @@
+      trace_option (simple_error "no functional entry") @@
       Tezos_utils.List.find_map is_main p in
     let {input;output} : anon_function_content = main in
     let%bind body = translate_function_body main in
@@ -895,6 +895,13 @@ module Translate_program = struct
     let%bind output = Translate_type.Ty.type_ output in
     ok ({input;output;body}:compiled_program)
 
+  let translate_entry (p:anon_function) : compiled_program result =
+    let {input;output} : anon_function_content = p.content in
+    let%bind body = translate_function_body p.content in
+    let%bind input = Translate_type.Ty.type_ input in
+    let%bind output = Translate_type.Ty.type_ output in
+    ok ({input;output;body}:compiled_program)
+
 end
 
 module Translate_ir = struct
@@ -931,10 +938,11 @@ end
 module Run = struct
 
   open Tezos_utils.Micheline
+  open! Translate_program
 
-  let run_aux (program:program) (input_michelson:Michelson.t) : ex_typed_value result =
+  let run_aux (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
     let open Meta_michelson.Wrap in
-    let%bind {input;output;body} = Translate_program.translate program in
+    let {input;output;body} : compiled_program = program in
     let (Ex_ty input_ty) = input in
     let (Ex_ty output_ty) = output in
     let%bind input =
@@ -952,15 +960,24 @@ module Run = struct
     ok (Ex_typed_value (output_ty, output))
 
   let run_node (program:program) (input:Michelson.t) : Michelson.t result =
-    let%bind (Ex_typed_value (output_ty, output)) = run_aux program input in
+    let%bind compiled = translate_program program "main" in
+    let%bind (Ex_typed_value (output_ty, output)) = run_aux compiled input in
     let%bind output =
       Trace.trace_tzresult_lwt (simple_error "error unparsing output") @@
       Tezos_utils.Memory_proto_alpha.unparse_michelson_data output_ty output in
     ok output
 
+  let run_entry (entry:anon_function) (input:value) : value result =
+    let%bind compiled = translate_entry entry in
+    let%bind input_michelson = translate_value input in
+    let%bind ex_ty_value = run_aux compiled input_michelson in
+    let%bind (result : value) = Translate_ir.translate_value ex_ty_value in
+    ok result
+
   let run (program:program) (input:value) : value result =
-    let%bind input_michelson = Translate_program.translate_value input in
+    let%bind input_michelson = translate_value input in
-    let%bind ex_ty_value = run_aux program input_michelson in
+    let%bind compiled = translate_program program "main" in
+    let%bind ex_ty_value = run_aux compiled input_michelson in
     let%bind (result : value) = Translate_ir.translate_value ex_ty_value in
     ok result
 

src/ligo/transpiler.ml

@@ -176,30 +176,33 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express
   | Constant (name, lst) ->
       let%bind lst' = bind_list @@ List.map (translate_annotated_expression env) lst in
       ok (Predicate (name, lst'), tv, env)
-  | Lambda { binder ; input_type ; output_type ; body ; result } ->
+  | Lambda l -> translate_lambda env l tv
-      (* Try to type it in an empty env, if it succeeds, transpiles it as a quote value, else, as a closure expression. *)
+
-      let%bind empty_env =
+and translate_lambda env l tv =
-        let%bind input = translate_type input_type in
+  let { binder ; input_type ; output_type ; body ; result } : AST.lambda = l in
-        ok Environment.(add (binder, input) empty) in
+  (* Try to type it in an empty env, if it succeeds, transpiles it as a quote value, else, as a closure expression. *)
-      match to_option (translate_block empty_env body), to_option (translate_annotated_expression empty_env result) with
+  let%bind empty_env =
-      | Some body, Some result ->
+    let%bind input = translate_type input_type in
-          let capture_type = No_capture in
+    ok Environment.(add (binder, input) empty) in
-          let%bind input = translate_type input_type in
+  match to_option (translate_block empty_env body), to_option (translate_annotated_expression empty_env result) with
-          let%bind output = translate_type output_type in
+  | Some body, Some result ->
-          let content = {binder;input;output;body;result;capture_type} in
+      let capture_type = No_capture in
-          ok (Literal (`Function {capture=None;content}), tv, env)
+      let%bind input = translate_type input_type in
-      | _ ->
+      let%bind output = translate_type output_type in
-          (* Shallow capture. Capture the whole environment. Extend it with a new scope. Append it the input. *)
+      let content = {binder;input;output;body;result;capture_type} in
-          let%bind input = translate_type input_type in
+      ok (Literal (`Function {capture=None;content}), tv, env)
-          let sub_env = Environment.extend env in
+  | _ ->
-          let full_env = Environment.add (binder, input) sub_env in
+      (* Shallow capture. Capture the whole environment. Extend it with a new scope. Append it the input. *)
-          let%bind (_, post_env) as body = translate_block full_env body in
+      let%bind input = translate_type input_type in
-          let%bind result = translate_annotated_expression post_env result in
+      let sub_env = Environment.extend env in
-          let capture_type = Shallow_capture sub_env in
+      let full_env = Environment.add (binder, input) sub_env in
-          let input = Environment.to_mini_c_type full_env in
+      let%bind (_, post_env) as body = translate_block full_env body in
-          let%bind output = translate_type output_type in
+      let%bind result = translate_annotated_expression post_env result in
-          let content = {binder;input;output;body;result;capture_type} in
+      let capture_type = Shallow_capture sub_env in
-          ok (Function_expression content, tv, env)
+      let input = Environment.to_mini_c_type full_env in
+      let%bind output = translate_type output_type in
+      let content = {binder;input;output;body;result;capture_type} in
+      ok (Function_expression content, tv, env)
 
 let translate_declaration env (d:AST.declaration) : toplevel_statement result =
   match d with
@@ -217,6 +220,13 @@ let translate_program (lst:AST.program) : program result =
   let%bind (statements, _) = List.fold_left aux (ok ([], Environment.empty)) lst in
   ok statements
 
+let translate_main (l:AST.lambda) (t:AST.type_value) : anon_function result =
+  let%bind t' = translate_type t in
+  let%bind (expr, _, _) = translate_lambda Environment.empty l t' in
+  match expr with
+  | Literal (`Function f) -> ok f
+  | _ -> simple_fail "main is not a function"
+
 open Combinators
 
 let rec exp x n =
@@ -303,7 +313,7 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
   | Type_record m ->
       let lst = kv_list_of_map m in
       let%bind node = match Append_tree.of_list lst with
-        | Empty -> simple_fail "empty tuple"
+        | Empty -> simple_fail "empty record"
         | Full t -> ok t in
       let%bind lst = extract_record v node in
       let%bind lst = bind_list