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

generating good code

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-17 13:36:33 +02:00
parent b044a4fbc5
commit dfcccff748
36 changed files with 109 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/passes/01-parser/cameligo/AST.ml
View File

@ -402,9 +402,7 @@ and cond_expr = {
and code_insert = {
language : string reg;
code : string reg;
colon : colon;
type_anno : type_expr;
code : expr;
rbracket : rbracket;
}
(* Projecting regions from some nodes of the AST *)

8
src/passes/01-parser/cameligo/Parser.mly
View File

@ -709,12 +709,10 @@ seq_expr:
disj_expr_level | if_then_else (seq_expr) { $1 }
code_insert:
Insert "<verbatim>" ":" type_expr "]" {
let region = cover $1.region $5 in
Insert expr "]" {
let region = cover $1.region $3 in
let value = {
language =$1;
code =$2;
colon =$3;
type_anno=$4;
rbracket =$5}
rbracket =$3}
in {region; value} }

14
src/passes/01-parser/cameligo/ParserLog.ml
View File

@ -520,11 +520,9 @@ and print_record_expr state e =
print_ne_injection state print_field_assign e
and print_code_insert state {value; _} =
let {language;code;colon;type_anno;rbracket} : code_insert = value in
let {language;code;rbracket} : code_insert = value in
print_string state language;
print_string state code;
print_token state colon ":";
print_type_expr state type_anno;
print_expr state code;
print_token state rbracket "]"
and print_field_assign state {value; _} =
@ -901,12 +899,8 @@ and pp_code_insert state (rc : code_insert) =
let () =
let state = state#pad 3 1 in
pp_node state "<code>";
pp_string (state#pad 1 0) rc.code in
let () =
let state = state#pad 3 2 in
pp_node state "<type annotation>";
pp_type_expr (state#pad 1 0) rc.type_anno
in ()
pp_expr (state#pad 1 0) rc.code in
()
and pp_let_in state node =
let {binding; body; attributes; kwd_rec; _} = node in

4
src/passes/01-parser/pascaligo/AST.ml
View File

@ -439,9 +439,7 @@ and for_collect = {
and code_insert = {
language : string reg;
code : string reg;
colon : colon;
type_anno : type_expr;
code : expr;
rbracket : rbracket;
}

8
src/passes/01-parser/pascaligo/Parser.mly
View File

@ -975,14 +975,12 @@ update_record:
in {region; value} }
code_insert_expr:
Insert "<verbatim>" ":" type_expr "]" {
let region = cover $1.region $5 in
Insert expr "]" {
let region = cover $1.region $3 in
let value = {
language =$1;
code =$2;
colon =$3;
type_anno=$4;
rbracket =$5}
rbracket =$3}
in {region; value} }
field_assignment:

14
src/passes/01-parser/pascaligo/ParserLog.ml
View File

@ -231,11 +231,9 @@ and print_fun_expr state {value; _} =
print_expr state return
and print_code_insert state {value; _} =
let {language;code;colon;type_anno;rbracket} : code_insert = value in
let {language;code;rbracket} : code_insert = value in
print_string state language;
print_string state code;
print_token state colon ":";
print_type_expr state type_anno;
print_expr state code;
print_token state rbracket "]"
and print_parameters state {value; _} =
@ -1027,12 +1025,8 @@ and pp_code_insert state (rc : code_insert) =
let () =
let state = state#pad 3 1 in
pp_node state "<code>";
pp_string (state#pad 1 0) rc.code in
let () =
let state = state#pad 3 2 in
pp_node state "<type annotation>";
pp_type_expr (state#pad 1 0) rc.type_anno
in ()
pp_expr (state#pad 1 0) rc.code in
()
and pp_parameters state {value; _} =
let params = Utils.nsepseq_to_list value.inside in

8
src/passes/01-parser/reasonligo/Parser.mly
View File

@ -921,14 +921,12 @@ update_record:
in {region; value} }
code_insert:
Insert "<verbatim>" ":" type_expr "]" {
let region = cover $1.region $5 in
Insert expr "]" {
let region = cover $1.region $3 in
let value = {
language =$1;
code =$2;
colon =$3;
type_anno=$4;
rbracket =$5}
rbracket =$3}
in {region; value} }
expr_with_let_expr:

5
src/passes/02-concrete_to_imperative/cameligo.ml
View File

@ -641,9 +641,8 @@ in trace (abstracting_expr t) @@
| ECodeInsert ci -> (
let (ci, loc) = r_split ci in
let language = ci.language.value in
let code = ci.code.value in
let%bind type_anno = compile_type_expression ci.type_anno in
return @@ e_raw_code ~loc language code type_anno
let%bind code = compile_expression ci.code in
return @@ e_raw_code ~loc language code
)
and compile_fun lamb' : expr result =

5
src/passes/02-concrete_to_imperative/pascaligo.ml
View File

@ -462,9 +462,8 @@ let rec compile_expression (t:Raw.expr) : expr result =
| ECodeInsert ci ->
let (ci, loc) = r_split ci in
let language = ci.language.value in
let code = ci.code.value in
let%bind type_anno = compile_type_expression ci.type_anno in
return @@ e_raw_code ~loc language code type_anno
let%bind code = compile_expression ci.code in
return @@ e_raw_code ~loc language code
and compile_update (u: Raw.update Region.reg) =
let u, loc = r_split u in

12
src/passes/04-imperative_to_sugar/imperative_to_sugar.ml
View File

@ -218,9 +218,9 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression)
let%bind rhs = compile_expression rhs in
let%bind let_result = compile_expression let_result in
return @@ O.e_let_in ~loc (binder,ty_opt) false inline rhs let_result
| I.E_raw_code {language;code;type_anno} ->
let%bind type_anno = compile_type_expression type_anno in
return @@ O.e_raw_code ~loc language code type_anno
| I.E_raw_code {language;code} ->
let%bind code = compile_expression code in
return @@ O.e_raw_code ~loc language code
| I.E_constructor {constructor;element} ->
let%bind element = compile_expression element in
return @@ O.e_constructor ~loc constructor element
@ -616,9 +616,9 @@ let rec uncompile_expression : O.expression -> I.expression result =
let%bind rhs = uncompile_expression rhs in
let%bind let_result = uncompile_expression let_result in
return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
| O.E_raw_code {language;code;type_anno} ->
let%bind type_anno = uncompile_type_expression type_anno in
return @@ I.E_raw_code {language;code;type_anno}
| O.E_raw_code {language;code} ->
let%bind code = uncompile_expression' code in
return @@ I.E_raw_code {language;code}
| O.E_constructor {constructor;element} ->
let%bind element = uncompile_expression element in
return @@ I.E_constructor {constructor;element}

12
src/passes/06-sugar_to_core/sugar_to_core.ml
View File

@ -71,9 +71,9 @@ let rec compile_expression : I.expression -> O.expression result =
let%bind rhs = compile_expression rhs in
let%bind let_result = compile_expression let_result in
return @@ O.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
| I.E_raw_code {language;code;type_anno} ->
let%bind type_anno = compile_type_expression type_anno in
return @@ O.E_raw_code {language;code;type_anno}
| I.E_raw_code {language;code} ->
let%bind code = compile_expression code in
return @@ O.E_raw_code {language;code}
| I.E_constructor {constructor;element} ->
let%bind element = compile_expression element in
return @@ O.E_constructor {constructor;element}
@ -331,9 +331,9 @@ let rec uncompile_expression : O.expression -> I.expression result =
let%bind rhs = uncompile_expression rhs in
let%bind let_result = uncompile_expression let_result in
return @@ I.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result}
| O.E_raw_code {language;code;type_anno} ->
let%bind type_anno = uncompile_type_expression type_anno in
return @@ I.E_raw_code {language;code;type_anno}
| O.E_raw_code {language;code} ->
let%bind code = uncompile_expression code in
return @@ I.E_raw_code {language;code}
| O.E_constructor {constructor;element} ->
let%bind element = uncompile_expression element in
return @@ I.E_constructor {constructor;element}

8
src/passes/08-typer-new/typer.ml
View File

@ -332,10 +332,10 @@ and type_expression : environment -> O'.typer_state -> ?tv_opt:O.type_expression
let wrapped =
Wrap.let_in rhs.type_expression rhs_tv_opt let_result.type_expression in
return_wrapped (E_let_in {let_binder; rhs; let_result; inline}) state'' wrapped
| E_raw_code {language ; code; type_anno} ->
let%bind type_anno = evaluate_type e type_anno in
let wrapped = Wrap.raw_code type_anno in
return_wrapped (E_raw_code {language; code ;type_anno}) state wrapped
| E_raw_code {language ; code} ->
let%bind (code,state') = type_expression e state code in
let wrapped = Wrap.raw_code code.type_expression in
return_wrapped (E_raw_code {language; code}) state' wrapped
| E_ascription {anno_expr;type_annotation} ->
let%bind tv = evaluate_type e type_annotation in
let%bind (expr' , state') = type_expression e state anno_expr in

6
src/passes/08-typer-new/untyper.ml
View File

@ -282,9 +282,9 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
let%bind rhs = untype_expression rhs in
let%bind result = untype_expression let_result in
return (e_let_in (let_binder , (Some tv)) inline rhs result)
| E_raw_code {language; code; type_anno} ->
let%bind type_anno = untype_type_expression type_anno in
return @@ e_raw_code language code type_anno
| E_raw_code {language; code} ->
let%bind code = untype_expression code in
return @@ e_raw_code language code
| E_recursive {fun_name; fun_type; lambda} ->
let%bind lambda = untype_lambda fun_type lambda in
let%bind fun_type = untype_type_expression fun_type in

16
src/passes/08-typer-old/typer.ml
View File

@ -936,10 +936,12 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
let e' = Environment.add_ez_declaration (let_binder) rhs e in
let%bind let_result = type_expression' e' let_result in
return (E_let_in {let_binder; rhs; let_result; inline}) let_result.type_expression
| E_raw_code {language;code;type_anno} ->
let%bind type_anno = evaluate_type e type_anno in
let%bind (_input_type,_output_type) = get_t_function type_anno in
return (E_raw_code {language;code;type_anno}) type_anno
| E_raw_code {language;code} ->
let%bind (code,type_expression) = I.get_e_ascription code.expression_content in
let%bind code = type_expression' e code in
let%bind type_expression = evaluate_type e type_expression in
let code = {code with type_expression} in
return (E_raw_code {language;code}) code.type_expression
| E_recursive {fun_name; fun_type; lambda} ->
let%bind fun_type = evaluate_type e fun_type in
let e' = Environment.add_ez_binder fun_name fun_type e in
@ -1076,9 +1078,9 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
let%bind rhs = untype_expression rhs in
let%bind result = untype_expression let_result in
return (e_let_in (let_binder , (Some tv)) inline rhs result)
| E_raw_code {language; code; type_anno} ->
let%bind type_anno = untype_type_expression type_anno in
return (e_raw_code language code type_anno)
| E_raw_code {language; code} ->
let%bind code = untype_expression code in
return (e_raw_code language code)
| E_recursive {fun_name;fun_type; lambda} ->
let%bind fun_type = untype_type_expression fun_type in
let%bind unty_expr= untype_expression_content ty @@ E_lambda lambda in

4
src/passes/10-transpiler/transpiler.ml
View File

@ -616,12 +616,14 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
aux expr' tree''
)
)
| E_raw_code { language; code; type_anno} ->
| E_raw_code { language; code} ->
let backend = "Michelson" in
let%bind () = trace_strong (language_backend_mismatch language backend ae.location) @@
Assert.assert_true (String.equal language backend)
in
let type_anno = get_type_expression code in
let%bind type_anno' = transpile_type type_anno in
let%bind code = get_a_verbatim code in
return @@ E_raw_michelson (code, type_anno')
and transpile_lambda l (input_type , output_type) =

5
src/passes/12-compiler/compiler_program.ml
View File

@ -486,9 +486,8 @@ and translate_expression (expr:expression) (env:environment) : michelson result
| E_raw_michelson (code, type_anno) ->
let (code, _e) = Michelson_parser.V1.parse_expression ~check:false code in
let code = Tezos_micheline.Micheline.root code.expanded in
let annot = Format.asprintf "(%a)" Mini_c.PP.type_value type_anno in
return @@ Michelson.prim ~children:[code] ~annot:[annot] I_PUSH
let%bind ty = Compiler_type.type_ type_anno in
return @@ i_push ty code
and translate_function_body ({body ; binder} : anon_function) lst input : michelson result =
let pre_env = Environment.of_list lst in

4
src/stages/1-ast_imperative/PP.ml
View File

@ -113,8 +113,8 @@ and expression_content ppf (ec : expression_content) =
expression_content (E_lambda lambda)
| E_let_in { let_binder ; rhs ; let_result; inline } ->
fprintf ppf "let %a = %a%a in %a" option_type_name let_binder expression rhs option_inline inline expression let_result
| E_raw_code {language; code; type_anno} ->
fprintf ppf "[%%%s {%s} : %a]" language code type_expression type_anno
| E_raw_code {language; code} ->
fprintf ppf "[%%%s %a]" language expression code
| E_ascription {anno_expr; type_annotation} ->
fprintf ppf "%a : %a" expression anno_expr type_expression
type_annotation

2
src/stages/1-ast_imperative/combinators.ml
View File

@ -115,7 +115,7 @@ let e_application ?loc a b = make_e ?loc @@ E_application {lamb=a ; args=b}
let e_lambda ?loc binder input_type output_type result : expression = make_e ?loc @@ E_lambda {binder; input_type; output_type; result}
let e_recursive ?loc fun_name fun_type lambda = make_e ?loc @@ E_recursive {fun_name; fun_type; lambda}
let e_let_in ?loc (binder, ascr) inline rhs let_result = make_e ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline }
let e_raw_code ?loc language code type_anno = make_e ?loc @@ E_raw_code {language; code; type_anno}
let e_raw_code ?loc language code = make_e ?loc @@ E_raw_code {language; code}
let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constructor = Constructor s; element = a}
let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b}

2
src/stages/1-ast_imperative/combinators.mli
View File

@ -95,7 +95,7 @@ val e_application : ?loc:Location.t -> expression -> expression -> expression
val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
val e_raw_code : ?loc:Location.t -> string -> string -> type_expression -> expression
val e_raw_code : ?loc:Location.t -> string -> expression -> expression
val e_constructor : ?loc:Location.t -> string -> expression -> expression
val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression

3
src/stages/1-ast_imperative/types.ml
View File

@ -103,8 +103,7 @@ and let_in =
and raw_code = {
language : string ;
code : string ;
type_anno : type_expression ;
code : expression ;
}
and constructor = {constructor: constructor'; element: expression}

4
src/stages/2-ast_sugar/PP.ml
View File

@ -112,8 +112,8 @@ and expression_content ppf (ec : expression_content) =
expression rhs
option_inline inline
expression let_result
| E_raw_code {language; code; type_anno} ->
fprintf ppf "[%%%s {%s} : %a]" language code type_expression type_anno
| E_raw_code {language; code} ->
fprintf ppf "[%%%s %a]" language expression code
| E_ascription {anno_expr; type_annotation} ->
fprintf ppf "%a : %a" expression anno_expr type_expression type_annotation
| E_cond {condition; then_clause; else_clause} ->

2
src/stages/2-ast_sugar/combinators.ml
View File

@ -103,8 +103,8 @@ let e_application ?loc a b = make_e ?loc @@ E_application {lamb=a ; args=b}
let e_lambda ?loc binder input_type output_type result : expression = make_e ?loc @@ E_lambda {binder; input_type; output_type; result}
let e_recursive ?loc fun_name fun_type lambda = make_e ?loc @@ E_recursive {fun_name; fun_type; lambda}
let e_let_in ?loc (binder, ascr) mut inline rhs let_result = make_e ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline; mut }
let e_raw_code ?loc language code = make_e ?loc @@ E_raw_code {language; code}
let e_raw_code ?loc language code type_anno: expression = make_e ?loc @@ E_raw_code { language; code; type_anno}
let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constructor = s; element = a}
let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b}

2
src/stages/2-ast_sugar/combinators.mli
View File

@ -70,7 +70,6 @@ val e_some : ?loc:Location.t -> expression -> expression
val e_none : ?loc:Location.t -> unit -> expression
val e_variable : ?loc:Location.t -> expression_variable -> expression
val e_raw_code : ?loc:Location.t -> string -> string -> type_expression -> expression
val e_constructor : ?loc:Location.t -> constructor' -> expression -> expression
val e_constant : ?loc:Location.t -> constant' -> expression list -> expression
@ -78,6 +77,7 @@ val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option
val e_application : ?loc:Location.t -> expression -> expression -> expression
val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> bool -> expression -> expression -> expression
val e_raw_code : ?loc:Location.t -> string -> expression -> expression
val e_record : ?loc:Location.t -> expr label_map -> expression
val e_accessor : ?loc:Location.t -> expression -> access list -> expression

3
src/stages/2-ast_sugar/types.ml
View File

@ -101,8 +101,7 @@ and let_in = {
and raw_code = {
language : string ;
code : string ;
type_anno : type_expression ;
code : expression ;
}
and constructor = {constructor: constructor'; element: expression}

4
src/stages/3-ast_core/PP.ml
View File

@ -48,8 +48,8 @@ and expression_content ppf (ec : expression_content) =
cases
| E_let_in { let_binder ;rhs ; let_result; inline } ->
fprintf ppf "@[let %a =@;<1 2>%a%a in@ %a@]" option_type_name let_binder expression rhs option_inline inline expression let_result
| E_raw_code {language; code; type_anno} ->
fprintf ppf "[%%%s {%s} : %a]" language code type_expression type_anno
| E_raw_code {language; code} ->
fprintf ppf "[%%%s %a]" language expression code
| E_ascription {anno_expr; type_annotation} ->
fprintf ppf "%a : %a" expression anno_expr type_expression
type_annotation

7
src/stages/3-ast_core/combinators.ml
View File

@ -102,7 +102,7 @@ let e_application ?loc a b = make_e ?loc @@ E_application {lamb=a ; args=b}
let e_lambda ?loc binder input_type output_type result = make_e ?loc @@ E_lambda {binder; input_type; output_type; result ; }
let e_recursive ?loc fun_name fun_type lambda = make_e ?loc @@ E_recursive {fun_name; fun_type; lambda}
let e_let_in ?loc (binder, ascr) inline rhs let_result = make_e ?loc @@ E_let_in { let_binder = (binder,ascr) ; rhs ; let_result; inline }
let e_raw_code ?loc language code type_anno = make_e ?loc @@ E_raw_code {language; code; type_anno}
let e_raw_code ?loc language code = make_e ?loc @@ E_raw_code {language; code}
let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constructor = Constructor s; element = a}
let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b}
@ -164,6 +164,11 @@ let get_e_tuple = fun t ->
| E_record r -> ok @@ List.map snd @@ Stage_common.Helpers.tuple_of_record r
| _ -> simple_fail "ast_core: get_e_tuple: not a tuple"
let get_e_ascription = fun a ->
match a with
| E_ascription {anno_expr; type_annotation} -> ok @@ (anno_expr,type_annotation)
| _ -> simple_fail "ast_core: get_e_ascription: not an ascription"
(* Same as get_e_pair *)
let extract_pair : expression -> (expression * expression) result = fun e ->
match e.expression_content with

3
src/stages/3-ast_core/combinators.mli
View File

@ -77,7 +77,7 @@ val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
val e_record_accessor : ?loc:Location.t -> expression -> label -> expression
val e_variable : ?loc:Location.t -> expression_variable -> expression
val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
val e_raw_code : ?loc:Location.t -> string -> string -> type_expression -> expression
val e_raw_code : ?loc:Location.t -> string -> expression -> expression
val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
val e_application : ?loc:Location.t -> expression -> expression -> expression
val e_constant : ?loc:Location.t -> constant' -> expression list -> expression
@ -101,6 +101,7 @@ val get_e_pair : expression_content -> ( expression * expression ) result
val get_e_list : expression_content -> ( expression list ) result
val get_e_tuple : expression_content -> ( expression list ) result
val get_e_ascription : expression_content -> ( expression * type_expression ) result
(*
val get_e_failwith : expression -> expression result
val is_e_failwith : expression -> bool

3
src/stages/3-ast_core/types.ml
View File

@ -74,8 +74,7 @@ and let_in =
and raw_code = {
language : string ;
code : string ;
type_anno : type_expression ;
code : expression ;
}
and constructor = {constructor: constructor'; element: expression}

4
src/stages/4-ast_typed/PP.ml
View File

@ -291,8 +291,8 @@ and expression_content ppf (ec: expression_content) =
| E_let_in {let_binder; rhs; let_result; inline} ->
fprintf ppf "let %a = %a%a in %a" expression_variable let_binder expression
rhs option_inline inline expression let_result
| E_raw_code {language; code; type_anno} ->
fprintf ppf "[%%%s {%s} : %a]" language code type_expression type_anno
| E_raw_code {language; code} ->
fprintf ppf "[%%%s %a]" language expression code
| E_recursive { fun_name;fun_type; lambda} ->
fprintf ppf "rec (%a:%a => %a )"
expression_variable fun_name

10
src/stages/4-ast_typed/combinators.ml
View File

@ -360,6 +360,16 @@ let get_a_int (t:expression) =
| E_literal (Literal_int n) -> ok n
| _ -> simple_fail "not an int"
let get_a_string (t:expression) =
match t.expression_content with
| E_literal (Literal_string s) -> ok @@ Ligo_string.extract s
| _ -> simple_fail "not a string"
let get_a_verbatim (t:expression) =
match t.expression_content with
E_literal (Literal_string (Verbatim v)) -> ok @@ v
| _ -> simple_fail "not a verbatim string"
let get_a_unit (t:expression) =
match t.expression_content with
| E_literal (Literal_unit) -> ok ()

2
src/stages/4-ast_typed/combinators.mli
View File

@ -152,6 +152,8 @@ val ez_e_a_record : ( label * expression ) list -> expression
val e_a_let_in : expression_variable -> bool -> expression -> expression -> expression
val get_a_int : expression -> Z.t result
val get_a_string : expression -> string result
val get_a_verbatim : expression -> string result
val get_a_unit : expression -> unit result
val get_a_bool : expression -> bool result
val get_a_record_accessor : expression -> (expression * label) result

24
src/stages/5-mini_c/PP.ml
View File

@ -70,20 +70,20 @@ let rec value ppf : value -> unit = function
| D_list lst -> fprintf ppf "List[%a]" (list_sep_d value) lst
| D_set lst -> fprintf ppf "Set[%a]" (list_sep_d value) lst
and type_value_annotated ppf : type_value annotated -> unit = fun (_, tv) ->
type_value ppf tv
and type_expression_annotated ppf : type_expression annotated -> unit = fun (_, tv) ->
type_expression ppf tv
and type_value ppf : type_value -> unit = function
| T_pair (a,b) -> fprintf ppf "pair %a %a" type_value_annotated a type_value_annotated b
| T_or (a,b) -> fprintf ppf "or %a %a" type_value_annotated a type_value_annotated b
| T_function (a, b) -> fprintf ppf "lambda (%a) %a" type_value a type_value b
and type_expression ppf : type_expression -> unit = fun te -> match te.type_content with
| T_pair (a,b) -> fprintf ppf "pair %a %a" type_expression_annotated a type_expression_annotated b
| T_or (a,b) -> fprintf ppf "or %a %a" type_expression_annotated a type_expression_annotated b
| T_function (a, b) -> fprintf ppf "lambda (%a) %a" type_expression a type_expression b
| T_base tc -> fprintf ppf "%a" type_constant tc
| T_map (k,v) -> fprintf ppf "Map (%a,%a)" type_value k type_value v
| T_big_map (k,v) -> fprintf ppf "BigMap (%a,%a)" type_value k type_value v
| T_list e -> fprintf ppf "List (%a)" type_value e
| T_set e -> fprintf ppf "Set (%a)" type_value e
| T_contract c -> fprintf ppf "Contract (%a)" type_value c
| T_option c -> fprintf ppf "Option (%a)" type_value c
| T_map (k,v) -> fprintf ppf "Map (%a,%a)" type_expression k type_expression v
| T_big_map (k,v) -> fprintf ppf "BigMap (%a,%a)" type_expression k type_expression v
| T_list e -> fprintf ppf "List (%a)" type_expression e
| T_set e -> fprintf ppf "Set (%a)" type_expression e
| T_contract c -> fprintf ppf "Contract (%a)" type_expression c
| T_option c -> fprintf ppf "Option (%a)" type_expression c
and value_assoc ppf : (value * value) -> unit = fun (a, b) ->
fprintf ppf "%a -> %a" value a value b

2
src/stages/5-mini_c/PP.mli
View File

@ -12,7 +12,7 @@ val type_variable : formatter -> type_expression -> unit
val environment_element : formatter -> environment_element -> unit
val environment : formatter -> environment -> unit
val value : formatter -> value -> unit
val type_value : formatter -> type_value -> unit
val type_expression : formatter -> type_expression -> unit
(*
val value_assoc : formatter -> (value * value) -> unit

2
src/stages/5-mini_c/types.ml
View File

@ -91,7 +91,7 @@ and expression_content =
| E_sequence of (expression * expression)
| E_record_update of (expression * [`Left | `Right] list * expression)
| E_while of (expression * expression)
| E_raw_michelson of (string * type_value)
| E_raw_michelson of (string * type_expression)
and expression = {
content : expression_content ;

6
src/stages/typesystem/misc.ml
View File

@ -159,9 +159,9 @@ module Substitution = struct
let%bind rhs = s_expression ~substs rhs in
let%bind let_result = s_expression ~substs let_result in
ok @@ T.E_let_in { let_binder; rhs; let_result; inline }
| T.E_raw_code {language; code; type_anno} ->
let%bind type_anno = s_type_expression ~substs type_anno in
ok @@ T.E_raw_code {language; code; type_anno}
| T.E_raw_code {language; code} ->
let%bind code = s_expression ~substs code in
ok @@ T.E_raw_code {language; code}
| T.E_recursive { fun_name; fun_type; lambda} ->
let%bind fun_name = s_variable ~substs fun_name in
let%bind fun_type = s_type_expression ~substs fun_type in

2
src/test/contracts/michelson_insertion.mligo
View File

@ -1,5 +1,5 @@
// Test michelson insertion in CameLIGO
let michelson_add (n : nat) : nat =
let f : nat -> nat = [%Michelson {| DUP;ADD |}] in
let f : nat -> nat = [%Michelson ({| DUP;ADD |} : nat -> nat) ] in
f n