From 7ca28cb34a1e623cb5c6bd09ea33bb8d94756af6 Mon Sep 17 00:00:00 2001 From: Galfour Date: Sat, 13 Apr 2019 22:19:07 +0000 Subject: [PATCH] bin --- src/ligo/bin/cli.ml | 48 +++++++++++++++++------------ src/ligo/ligo_parser/ligo_parser.ml | 1 + src/ligo/mini_c/PP.ml | 12 ++++++-- src/ligo/mini_c/compiler.ml | 16 +++++++--- src/ligo/simplify.ml | 4 +-- 5 files changed, 53 insertions(+), 28 deletions(-) diff --git a/src/ligo/bin/cli.ml b/src/ligo/bin/cli.ml index 145efa795..5d2cf802e 100644 --- a/src/ligo/bin/cli.ml +++ b/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 () diff --git a/src/ligo/ligo_parser/ligo_parser.ml b/src/ligo/ligo_parser/ligo_parser.ml index 7d2570e25..8a76623e3 100644 --- a/src/ligo/ligo_parser/ligo_parser.ml +++ b/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 diff --git a/src/ligo/mini_c/PP.ml b/src/ligo/mini_c/PP.ml index 62b78d2db..450f901db 100644 --- a/src/ligo/mini_c/PP.ml +++ b/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 diff --git a/src/ligo/mini_c/compiler.ml b/src/ligo/mini_c/compiler.ml index cc7465d8d..348d50c36 100644 --- a/src/ligo/mini_c/compiler.ml +++ b/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 diff --git a/src/ligo/simplify.ml b/src/ligo/simplify.ml index a81c322f5..637cccacf 100644 --- a/src/ligo/simplify.ml +++ b/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