balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

rename Mini_c statements

Browse Source
This commit is contained in:
Galfour 2019-04-15 05:26:04 +00:00
parent 1007bfda1e
commit 68f37e14aa
6 changed files with 30 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/ligo/mini_c/PP.ml
View File

@ -90,13 +90,13 @@ and function_ ppf ({binder ; input ; output ; body ; result ; capture_type}:anon
and assignment ppf ((n, e):assignment) = fprintf ppf "let %s = %a;" n expression e and assignment ppf ((n, e):assignment) = fprintf ppf "let %s = %a;" n expression e
and statement ppf ((s, _) : statement) = match s with and statement ppf ((s, _) : statement) = match s with
| Assignment ass -> assignment ppf ass | S_assignment ass -> assignment ppf ass
| I_Cond (expr, i, e) -> fprintf ppf "if (%a) %a %a" expression expr block i block e | S_cond (expr, i, e) -> fprintf ppf "if (%a) %a %a" expression expr block i block e
| I_patch (r, path, e) -> | S_patch (r, path, e) ->
let aux = fun ppf -> function `Left -> fprintf ppf ".L" | `Right -> fprintf ppf ".R" in let aux = fun ppf -> function `Left -> fprintf ppf ".L" | `Right -> fprintf ppf ".R" in
fprintf ppf "%s%a := %a" r (list aux) path expression e fprintf ppf "%s%a := %a" r (list aux) path expression e
| If_None (expr, none, (name, some)) -> fprintf ppf "if (%a) %a %s.%a" expression expr block none name block some | S_if_none (expr, none, (name, some)) -> fprintf ppf "if (%a) %a %s.%a" expression expr block none name block some
| While (e, b) -> fprintf ppf "while (%a) %a" expression e block b | S_while (e, b) -> fprintf ppf "while (%a) %a" expression e block b
and block ppf ((b, _):block) = and block ppf ((b, _):block) =
fprintf ppf "{ @;@[<v 2>%a@]@;}" (pp_print_list ~pp_sep:(tag "@;") statement) b fprintf ppf "{ @;@[<v 2>%a@]@;}" (pp_print_list ~pp_sep:(tag "@;") statement) b

10
src/ligo/mini_c/combinators.ml
View File

@ -109,11 +109,11 @@ let id_environment_wrap e = environment_wrap e e
let statement s' e : statement = let statement s' e : statement =
match s' with match s' with
| I_Cond _ -> s', id_environment_wrap e | S_cond _ -> s', id_environment_wrap e
| If_None _ -> s', id_environment_wrap e | S_if_none _ -> s', id_environment_wrap e
| While _ -> s', id_environment_wrap e | S_while _ -> s', id_environment_wrap e
| I_patch _ -> s', id_environment_wrap e | S_patch _ -> s', id_environment_wrap e
| Assignment (name, (_, t, _)) -> s', environment_wrap e (Compiler_environment.add (name, t) e) | S_assignment (name, (_, t, _)) -> s', environment_wrap e (Compiler_environment.add (name, t) e)
let block (statements:statement list) : block result = let block (statements:statement list) : block result =
match statements with match statements with

10
src/ligo/mini_c/compiler.ml
View File

@ -291,7 +291,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
let error_message () = Format.asprintf "%a" PP.statement s in let error_message () = Format.asprintf "%a" PP.statement s in
let%bind (code : michelson) = let%bind (code : michelson) =
trace (fun () -> error (thunk "translating statement") error_message ()) @@ match s' with trace (fun () -> error (thunk "translating statement") error_message ()) @@ match s' with
| Assignment (s, ((_, tv, _) as expr)) -> | S_assignment (s, ((_, tv, _) as expr)) ->
let%bind expr = translate_expression expr in let%bind expr = translate_expression expr in
let%bind add = let%bind add =
if Environment.has s w_env.pre_environment if Environment.has s w_env.pre_environment
@ -309,7 +309,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
add ; add ;
]; ];
]) ])
| I_Cond (expr, a, b) -> | S_cond (expr, a, b) ->
let%bind expr = translate_expression expr in let%bind expr = translate_expression expr in
let%bind a = translate_regular_block a in let%bind a = translate_regular_block a in
let%bind b = translate_regular_block b in let%bind b = translate_regular_block b in
@ -320,7 +320,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
dip Environment.to_michelson_extend ; dip Environment.to_michelson_extend ;
prim ~children:[seq [a ; Environment.to_michelson_restrict];seq [b ; Environment.to_michelson_restrict]] I_IF ; prim ~children:[seq [a ; Environment.to_michelson_restrict];seq [b ; Environment.to_michelson_restrict]] I_IF ;
]) ])
| If_None (expr, none, (_, some)) -> | S_if_none (expr, none, (_, some)) ->
let%bind expr = translate_expression expr in let%bind expr = translate_expression expr in
let%bind none' = translate_regular_block none in let%bind none' = translate_regular_block none in
let%bind some' = translate_regular_block some in let%bind some' = translate_regular_block some in
@ -335,7 +335,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
seq [add ; some' ; Environment.to_michelson_restrict] ; seq [add ; some' ; Environment.to_michelson_restrict] ;
] I_IF_NONE ] I_IF_NONE
]) ])
| While ((_, _, _) as expr, block) -> | S_while ((_, _, _) as expr, block) ->
let%bind expr = translate_expression expr in let%bind expr = translate_expression expr in
let%bind block = translate_regular_block block in let%bind block = translate_regular_block block in
ok @@ (seq [ ok @@ (seq [
@ -346,7 +346,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
Environment.to_michelson_restrict ; Environment.to_michelson_restrict ;
i_push_unit ; expr ; i_car]] I_LOOP ; i_push_unit ; expr ; i_car]] I_LOOP ;
]) ])
| I_patch (name, lrs, expr) -> | S_patch (name, lrs, expr) ->
let%bind expr' = translate_expression expr in let%bind expr' = translate_expression expr in
let%bind (name_path, _) = Environment.get_path name w_env.pre_environment in let%bind (name_path, _) = Environment.get_path name w_env.pre_environment in
let path = name_path @ lrs in let path = name_path @ lrs in

10
src/ligo/mini_c/types.ml
View File

@ -70,11 +70,11 @@ and expression = expression' * type_value * environment (* Environment in which
and assignment = var_name * expression and assignment = var_name * expression
and statement' = and statement' =
| Assignment of assignment | S_assignment of assignment
| I_Cond of expression * block * block | S_cond of expression * block * block
| I_patch of string * [`Left | `Right] list * expression | S_patch of string * [`Left | `Right] list * expression
| If_None of expression * block * (var_name * block) | S_if_none of expression * block * (var_name * block)
| While of expression * block | S_while of expression * block
and statement = statement' * environment_wrap and statement = statement' * environment_wrap

10
src/ligo/test/compiler_tests.ml
View File

@ -12,7 +12,7 @@ let run_entry_int (e:anon_function) (n:int) : int result =
let identity () : unit result = let identity () : unit result =
let e = basic_int_quote_env in let e = basic_int_quote_env in
let s = statement (Assignment ("output", e_var_int "input" e)) e in let s = statement (S_assignment ("output", e_var_int "input" e)) e in
let%bind b = block [s] in let%bind b = block [s] in
let%bind f = basic_int_quote b in let%bind f = basic_int_quote b in
let%bind result = run_entry_int f 42 in let%bind result = run_entry_int f 42 in
@ -27,10 +27,10 @@ let multiple_vars () : unit result =
Yes. One could do a monad. Feel free when we have the time. Yes. One could do a monad. Feel free when we have the time.
*) *)
let ss = statements [ let ss = statements [
(fun e -> statement (Assignment ("a", e_var_int "input" e)) e) ; (fun e -> statement (S_assignment ("a", e_var_int "input" e)) e) ;
(fun e -> statement (Assignment ("b", e_var_int "input" e)) e) ; (fun e -> statement (S_assignment ("b", e_var_int "input" e)) e) ;
(fun e -> statement (Assignment ("c", e_var_int "a" e)) e) ; (fun e -> statement (S_assignment ("c", e_var_int "a" e)) e) ;
(fun e -> statement (Assignment ("output", e_var_int "c" e)) e) ; (fun e -> statement (S_assignment ("output", e_var_int "c" e)) e) ;
] e in ] e in
let%bind b = block ss in let%bind b = block ss in
let%bind f = basic_int_quote b in let%bind f = basic_int_quote b in

10
src/ligo/transpiler.ml
View File

@ -126,7 +126,7 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement op
match Environment.has name env with match Environment.has name env with
| true -> env | true -> env
| false -> Environment.add (name, t) env in | false -> Environment.add (name, t) env in
return ~env' (Assignment (name, expression)) return ~env' (S_assignment (name, expression))
| I_patch (r, s, v) -> ( | I_patch (r, s, v) -> (
let ty = r.type_value in let ty = r.type_value in
let aux : ((AST.type_value * [`Left | `Right] list) as 'a) -> AST.access -> 'a result = let aux : ((AST.type_value * [`Left | `Right] list) as 'a) -> AST.access -> 'a result =
@ -148,7 +148,7 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement op
in in
let%bind (_, path) = bind_fold_list aux (ty, []) s in let%bind (_, path) = bind_fold_list aux (ty, []) s in
let%bind v' = translate_annotated_expression env v in let%bind v' = translate_annotated_expression env v in
return (I_patch (r.type_name, path, v')) return (S_patch (r.type_name, path, v'))
) )
| I_matching (expr, m) -> ( | I_matching (expr, m) -> (
let%bind expr' = translate_annotated_expression env expr in let%bind expr' = translate_annotated_expression env expr in
@ -157,7 +157,7 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement op
| Match_bool {match_true ; match_false} -> ( | Match_bool {match_true ; match_false} -> (
let%bind true_branch = translate_block env' match_true in let%bind true_branch = translate_block env' match_true in
let%bind false_branch = translate_block env' match_false in let%bind false_branch = translate_block env' match_false in
return (I_Cond (expr', true_branch, false_branch)) return (S_cond (expr', true_branch, false_branch))
) )
| Match_option {match_none ; match_some = ((name, t), sm)} -> ( | Match_option {match_none ; match_some = ((name, t), sm)} -> (
let%bind none_branch = translate_block env' match_none in let%bind none_branch = translate_block env' match_none in
@ -165,7 +165,7 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement op
let%bind t' = translate_type t in let%bind t' = translate_type t in
let env' = Environment.add (name, t') env' in let env' = Environment.add (name, t') env' in
translate_block env' sm in translate_block env' sm in
return (If_None (expr', none_branch, (name, some_branch))) return (S_if_none (expr', none_branch, (name, some_branch)))
) )
| _ -> simple_fail "todo : match" | _ -> simple_fail "todo : match"
) )
@ -173,7 +173,7 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement op
let%bind expr' = translate_annotated_expression env expr in let%bind expr' = translate_annotated_expression env expr in
let env' = Environment.extend env in let env' = Environment.extend env in
let%bind body' = translate_block env' body in let%bind body' = translate_block env' body in
return (While (expr', body')) return (S_while (expr', body'))
| I_skip -> ok None | I_skip -> ok None
| I_fail _ -> simple_fail "todo : fail" | I_fail _ -> simple_fail "todo : fail"