bin

src/ligo/bin/cli.ml

@@ -1,24 +1,34 @@
 open Trace
 
-let () =
+let toplevel x =
+  match x with
+  | Trace.Ok () -> ()
+  | Errors ss ->
+      Format.printf "Errors: %a\n%!" errors_pp @@ List.map (fun f -> f()) ss
+
+let main () =
   let l = Array.length Sys.argv in
-  if l < 2
-  then raise (Failure "Pass a command") ;
-  Format.printf "Toto %d\n%!" (Array.length Sys.argv) ;
+  let%bind () =
+    if l < 2
+    then simple_fail "Pass a command"
+    else ok () in
   let command = Sys.argv.(1) in
-  let _ =
-    match command with
-    | "compile" -> (
-        let%bind () =
-          if l <> 4
-          then simple_fail "Bad number of argument to compile"
-          else ok () in
-        let source = Sys.argv.(2) in
-        let entry_point = Sys.argv.(3) in
-        let%bind michelson = Ligo.compile_file source entry_point in
-        Format.printf "%a" Micheline.Michelson.pp michelson ;
-        ok ()
-      )
+  (* Format.printf "Processing command %s (%d)\n" command l ; *)
+  match command with
+  | "compile" -> (
+      let%bind () =
+        if l <> 4
+        then simple_fail "Bad number of argument to compile"
+        else ok () in
+      let source = Sys.argv.(2) in
+      let entry_point = Sys.argv.(3) in
+      (* Format.printf "Compiling %s from %s\n%!" entry_point source ; *)
+      let%bind michelson =
+        trace (simple_error "compile michelson") @@
+        Ligo.compile_file source entry_point in
+      Format.printf "Program : %a\n" Micheline.Michelson.pp michelson ;
+      ok ()
+    )
     | _ -> simple_fail "Bad command"
-  in
-  ()
+
+let () = toplevel @@ main ()

src/ligo/ligo_parser/ligo_parser.ml

@@ -2,3 +2,4 @@ module Parser = Parser
 module AST = AST
 module Lexer = Lexer
 module LexToken = LexToken
+module ParserLog = ParserLog

src/ligo/mini_c/PP.ml

@@ -59,7 +59,7 @@ let rec value ppf : value -> unit = function
 and value_assoc ppf : (value * value) -> unit = fun (a, b) ->
   fprintf ppf "%a -> %a" value a value b
 
-and expression ppf ((e, _, _):expression) = match e with
+and expression' ppf (e:expression') = match e with
   | E_variable v -> fprintf ppf "%s" v
   | E_application(a, b) -> fprintf ppf "(%a)@(%a)" expression a expression b
   | E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst
@@ -69,8 +69,14 @@ and expression ppf ((e, _, _):expression) = match e with
   | E_make_none _ -> fprintf ppf "none"
   | E_Cond (c, a, b) -> fprintf ppf "%a ? %a : %a" expression c expression a expression b
 
-and function_ ppf ({binder ; input ; output ; body ; result}:anon_function_content) =
-  fprintf ppf "fun (%s:%a) : %a %a return %a"
+and expression ppf (e', _, _) = expression' ppf e'
+
+and function_ ppf ({binder ; input ; output ; body ; result ; capture_type}:anon_function_content) =
+  fprintf ppf "fun[%s] (%s:%a) : %a %a return %a"
+    (match capture_type with
+     | No_capture -> "quote"
+     | Shallow_capture _ -> "shallow"
+     | Deep_capture _ -> "deep")
     binder
     type_ input
     type_ output

src/ligo/mini_c/compiler.ml

@@ -432,12 +432,20 @@ type compiled_program = {
 }
 
 let translate_program (p:program) (entry:string) : compiled_program result =
-  let is_main ((s, _):toplevel_statement) = match s with
-    | name , (E_function f, T_function (_, _), _) when f.capture_type = No_capture && name = entry -> Some f
-    | _ -> None in
+  let is_main ((s, _):toplevel_statement) =
+    match s with
+    | name , (E_function f, T_function (_, _), _)
+      when f.capture_type = No_capture && name = entry ->
+        Some f
+    | name , (E_literal (D_function {content ; capture = None}), T_function (_, _), _)
+      when name = entry ->
+        Some content
+    | _ ->  None
+  in
   let%bind main =
     trace_option (simple_error "no functional entry") @@
-    Tezos_utils.List.find_map is_main p in
+    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
   let%bind input = Compiler_type.Ty.type_ input in

src/ligo/simplify.ml

@@ -401,7 +401,7 @@ and simpl_single_instruction : Raw.single_instr -> instruction result = fun t ->
             ok @@ I_assignment {name = name.value ; annotated_expression = value_expr}
           )
         | Path path -> (
-            let err_content () = Format.asprintf "%a" (PP_helpers.printer Raw.print_path) path in
+            let err_content () = Format.asprintf "%a" (PP_helpers.printer Ligo_parser.ParserLog.print_path) path in
             fail @@ (fun () -> error (thunk "no path assignments") err_content ())
           )
         | MapPath v -> (
@@ -432,7 +432,7 @@ and simpl_single_instruction : Raw.single_instr -> instruction result = fun t ->
       let%bind record = match r.path with
         | Name v -> ok v.value
         | path -> (
-            let err_content () = Format.asprintf "%a" (PP_helpers.printer Raw.print_path) path in
+            let err_content () = Format.asprintf "%a" (PP_helpers.printer Ligo_parser.ParserLog.print_path) path in
             fail @@ (fun () -> error (thunk "no complex record patch yet") err_content ())
           )
       in