Merge branch 'feature/code_insertion' into 'dev'

Code insertion in Ligo

See merge request ligolang/ligo!579

src/bin/expect_tests/code_insertion.ml

@@ -0,0 +1,55 @@
+open Cli_expect
+
+let contract basename =
+  "../../test/contracts/" ^ basename
+let bad_contract basename =
+  "../../test/contracts/negative/" ^ basename
+
+let%expect_test _ =
+  run_ligo_bad [ "compile-contract" ; bad_contract "bad_michelson_insertion_1.ligo" ; "main" ] ;
+  [%expect{|
+    ligo: generated Michelson contract failed to typecheck: bad contract type
+          { parameter nat ;
+            storage nat ;
+            code { DUP ;
+                   LAMBDA (pair nat nat) nat ADD ;
+                   SWAP ;
+                   EXEC ;
+                   NIL operation ;
+                   PAIR ;
+                   DIP { DROP } } }
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/introduction
+    * Ask a question on our Discord: https://discord.gg/9rhYaEt
+    * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
+    * Check the changelog by running 'ligo changelog' |}]
+
+let%expect_test _ =
+  run_ligo_bad [ "compile-contract" ; bad_contract "bad_michelson_insertion_2.ligo" ; "main" ] ;
+  [%expect{|
+    ligo: in file "bad_michelson_insertion_2.ligo", line 5, characters 32-40. different kinds:  {"a":"nat","b":"( nat * nat )"}
+
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/introduction
+    * Ask a question on our Discord: https://discord.gg/9rhYaEt
+    * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
+    * Check the changelog by running 'ligo changelog' |}]
+
+let%expect_test _ =
+  run_ligo_good [ "compile-contract" ; bad_contract "bad_michelson_insertion_3.ligo" ; "main" ] ;
+  [%expect{|
+    { parameter nat ;
+      storage nat ;
+      code { DUP ;
+             LAMBDA (pair nat nat) nat { { { DUP ; CDR ; SWAP ; CAR } } ; ADD } ;
+             SWAP ;
+             EXEC ;
+             NIL operation ;
+             PAIR ;
+             DIP { DROP } } } |}]

src/passes/01-parser/cameligo/AST.ml

@@ -56,6 +56,7 @@ type c_Some  = Region.t
 
 type arrow    = Region.t  (* "->" *)
 type cons     = Region.t  (* "::" *)
+type percent  = Region.t  (* "%"  *)
 type cat      = Region.t  (* "^"  *)
 type append   = Region.t  (* "@"  *)
 type dot      = Region.t  (* "."  *)
@@ -246,6 +247,7 @@ and expr =
 | ELetIn      of let_in reg
 | EFun        of fun_expr reg
 | ESeq        of expr injection reg
+| ECodeInsert of code_insert reg
 
 and annot_expr = expr * colon * type_expr
 
@@ -398,6 +400,13 @@ and cond_expr = {
   ifnot    : expr
 }
 
+and code_insert = {
+  lbracket  : lbracket;
+  percent   : percent;
+  language  : string reg;
+  code      : expr;
+  rbracket  : rbracket;
+}
 (* Projecting regions from some nodes of the AST *)
 
 let rec last to_region = function
@@ -481,7 +490,8 @@ let expr_to_region = function
 | ECond {region;_}   | ETuple {region;_}   | ECase {region;_}
 | ECall {region;_}   | EVar {region; _}    | EProj {region; _}
 | EUnit {region;_}   | EPar {region;_}     | EBytes {region; _}
-| ESeq {region; _}   | ERecord {region; _} | EUpdate {region; _} -> region
+| ESeq {region; _}   | ERecord {region; _} | EUpdate {region; _} 
+| ECodeInsert {region; _} -> region
 
 let selection_to_region = function
   FieldName f -> f.region

src/passes/01-parser/cameligo/LexToken.mli

@@ -42,6 +42,7 @@ type t =
 | PLUS    of Region.t    (* "+" *)
 | SLASH   of Region.t    (* "/" *)
 | TIMES   of Region.t    (* "*" *)
+| PERCENT of Region.t    (* "%" *)
 
   (* Compounds *)
 

src/passes/01-parser/cameligo/LexToken.mll

@@ -26,6 +26,7 @@ type t =
 | PLUS    of Region.t    (* "+" *)
 | SLASH   of Region.t    (* "/" *)
 | TIMES   of Region.t    (* "*" *)
+| PERCENT of Region.t    (* "%" *)
 
   (* Compounds *)
 
@@ -140,6 +141,7 @@ let proj_token = function
 | PLUS     region -> region, "PLUS"
 | SLASH    region -> region, "SLASH"
 | TIMES    region -> region, "TIMES"
+| PERCENT  region -> region, "PERCENT"
 | LPAR     region -> region, "LPAR"
 | RPAR     region -> region, "RPAR"
 | LBRACKET region -> region, "LBRACKET"
@@ -214,6 +216,7 @@ let to_lexeme = function
 | PLUS     _ -> "+"
 | SLASH    _ -> "/"
 | TIMES    _ -> "*"
+| PERCENT  _ -> "%"
 | LPAR     _ -> "("
 | RPAR     _ -> ")"
 | LBRACKET _ -> "["
@@ -475,6 +478,7 @@ let mk_sym lexeme region =
   | "-"   -> Ok (MINUS    region)
   | "*"   -> Ok (TIMES    region)
   | "/"   -> Ok (SLASH    region)
+  | "%"   -> Ok (PERCENT  region)
   | "<"   -> Ok (LT       region)
   | "<="  -> Ok (LE       region)
   | ">"   -> Ok (GT       region)

src/passes/01-parser/cameligo/ParToken.mly

@@ -21,6 +21,7 @@
 %token <Region.t> PLUS    "+"
 %token <Region.t> SLASH   "/"
 %token <Region.t> TIMES   "*"
+%token <Region.t> PERCENT "%"
 
 %token <Region.t> LPAR     "("
 %token <Region.t> RPAR     ")"

src/passes/01-parser/cameligo/Parser.mly

@@ -583,6 +583,7 @@ core_expr:
 | sequence                            {                       ESeq $1 }
 | record_expr                         {                    ERecord $1 }
 | update_record                       {                    EUpdate $1 }
+| code_insert                         {                ECodeInsert $1 }
 | par(expr)                           {                       EPar $1 }
 | par(annot_expr)                     {                     EAnnot $1 }
 
@@ -706,3 +707,14 @@ last_expr:
 
 seq_expr:
   disj_expr_level | if_then_else (seq_expr) { $1 }
+
+code_insert:
+  "[" "%" Constr expr "]" {
+    let region = cover $1 $5 in
+    let value = {
+                  lbracket =$1;
+                  percent  =$2;
+                  language =$3;
+                  code     =$4;
+                  rbracket =$5}
+    in {region; value} }

src/passes/01-parser/cameligo/ParserLog.ml

@@ -366,6 +366,7 @@ and print_expr state = function
 | ESeq seq      -> print_sequence state seq
 | ERecord e     -> print_record_expr state e
 | EConstr e     -> print_constr_expr state e
+| ECodeInsert e -> print_code_insert state e
 
 and print_constr_expr state = function
   ENone e      -> print_none_expr       state e
@@ -518,6 +519,14 @@ and print_comp_expr state = function
 and print_record_expr state e =
   print_ne_injection state print_field_assign e
 
+and print_code_insert state {value; _} =
+  let {lbracket;percent;language;code;rbracket} : code_insert = value in
+  print_token     state lbracket "[";
+  print_token     state percent  "%";
+  print_string    state language;
+  print_expr      state code;
+  print_token     state rbracket "]"
+
 and print_field_assign state {value; _} =
   let {field_name; assignment; field_expr} = value in
   print_var   state field_name;
@@ -860,6 +869,9 @@ and pp_expr state = function
 | ESeq {value; region} ->
     pp_loc_node state "ESeq" region;
     pp_injection pp_expr state value
+| ECodeInsert {value; region} ->
+    pp_loc_node state "ECodeInsert" region;
+    pp_code_insert state value
 
 and pp_fun_expr state node =
   let {binders; lhs_type; body; _} = node in
@@ -881,6 +893,17 @@ and pp_fun_expr state node =
     pp_expr (state#pad 1 0) body
   in ()
 
+and pp_code_insert state (rc : code_insert) =
+  let () =
+    let state = state#pad 3 0 in
+    pp_node state "<language>";
+    pp_string (state#pad 1 0) rc.language in
+  let () =
+    let state = state#pad 3 1 in
+    pp_node state "<code>";
+    pp_expr (state#pad 1 0) rc.code in
+  ()
+
 and pp_let_in state node =
   let {binding; body; attributes; kwd_rec; _} = node in
   let {binders; lhs_type; let_rhs; _} = binding in

src/passes/01-parser/cameligo/Pretty.ml

@@ -152,6 +152,7 @@ and pp_expr = function
 | ELetIn      e -> pp_let_in e
 | EFun        e -> pp_fun e
 | ESeq        e -> pp_seq e
+| ECodeInsert e -> pp_code_insert e
 
 and pp_case_expr {value; _} =
   let {expr; cases; _} = value in
@@ -313,6 +314,12 @@ and pp_update {value; _} =
   string "{" ^^ record ^^ string " with"
   ^^ nest 2 (break 1 ^^ updates ^^ string "}")
 
+and pp_code_insert {value; _} =
+  let {language; code; _} = value in
+  let language = pp_string language 
+  and code = pp_expr code in
+  string "[%" ^^ language ^^ string " " ^^ code ^^ string " ]"
+
 and pp_field_path_assign {value; _} =
   let {field_path; field_expr; _} = value in
   let path = pp_path field_path in

src/passes/01-parser/pascaligo/AST.ml

@@ -82,6 +82,7 @@ type rbrace   = Region.t  (* "}"   *)
 type lbracket = Region.t  (* "["   *)
 type rbracket = Region.t  (* "]"   *)
 type cons     = Region.t  (* "#"   *)
+type percent  = Region.t  (* "%"   *)
 type vbar     = Region.t  (* "|"   *)
 type arrow    = Region.t  (* "->"  *)
 type assign   = Region.t  (* ":="  *)
@@ -436,6 +437,14 @@ and for_collect = {
   block      : block reg
 }
 
+and code_insert = {
+  lbracket  : lbracket;
+  percent   : percent;
+  language  : string reg;
+  code      : expr;
+  rbracket  : rbracket;
+}
+
 and collection =
   Map  of kwd_map
 | Set  of kwd_set
@@ -464,6 +473,7 @@ and expr =
 | ETuple  of tuple_expr
 | EPar    of expr par reg
 | EFun    of fun_expr reg
+| ECodeInsert of code_insert reg
 
 and annot_expr = expr * colon * type_expr
 
@@ -687,7 +697,8 @@ let rec expr_to_region = function
 | ECase  {region;_}
 | ECond  {region; _}
 | EPar   {region; _}
-| EFun   {region; _} -> region
+| EFun   {region; _}
+| ECodeInsert {region; _} -> region
 
 and tuple_expr_to_region {region; _} = region
 

src/passes/01-parser/pascaligo/LexToken.mli

@@ -73,6 +73,7 @@ type t =
 | DOT      of Region.t  (* "."   *)
 | WILD     of Region.t  (* "_"   *)
 | CAT      of Region.t  (* "^"   *)
+| PERCENT  of Region.t  (* "%"   *)
 
   (* Keywords *)
 

src/passes/01-parser/pascaligo/LexToken.mll

@@ -61,6 +61,7 @@ type t =
 | DOT      of Region.t
 | WILD     of Region.t
 | CAT      of Region.t
+| PERCENT  of Region.t  (* "%"   *)
 
   (* Keywords *)
 
@@ -141,6 +142,11 @@ let proj_token = function
 | Constr Region.{region; value} ->
     region, sprintf "Constr \"%s\"" value
 
+(*
+| Attr {header; string={region; value}} ->
+    region, sprintf "Attr (\"%s\",\"%s\")" header value
+ *)
+
   (* Symbols *)
 
 | SEMI     region -> region, "SEMI"
@@ -169,6 +175,7 @@ let proj_token = function
 | DOT      region -> region, "DOT"
 | WILD     region -> region, "WILD"
 | CAT      region -> region, "CAT"
+| PERCENT  region -> region, "PERCENT"
 
   (* Keywords *)
 
@@ -262,6 +269,7 @@ let to_lexeme = function
 | DOT      _ -> "."
 | WILD     _ -> "_"
 | CAT      _ -> "^"
+| PERCENT  _ -> "%"
 
   (* Keywords *)
 
@@ -365,7 +373,7 @@ let keywords = [
   (fun reg -> Unit       reg);
   (fun reg -> Var        reg);
   (fun reg -> While      reg);
-  (fun reg -> With       reg)
+  (fun reg -> With       reg);
 ]
 
 let reserved = SSet.empty
@@ -513,6 +521,7 @@ let mk_sym lexeme region =
   | "-"   -> Ok (MINUS    region)
   | "*"   -> Ok (TIMES    region)
   | "/"   -> Ok (SLASH    region)
+  | "%"   -> Ok (PERCENT  region)
   | "<"   -> Ok (LT       region)
   | "<="  -> Ok (LE       region)
   | ">"   -> Ok (GT       region)

src/passes/01-parser/pascaligo/ParToken.mly

@@ -42,6 +42,7 @@
 %token <Region.t> DOT         "."
 %token <Region.t> WILD        "_"
 %token <Region.t> CAT         "^"
+%token <Region.t> PERCENT     "%"
 
   (* Keywords *)
 

src/passes/01-parser/pascaligo/Parser.mly

@@ -855,6 +855,7 @@ core_expr:
 | set_expr                      { ESet $1                      }
 | record_expr                   { ERecord $1                   }
 | update_record                 { EUpdate $1                   }
+| code_insert_expr              { ECodeInsert $1               }
 | "<constr>" arguments {
     let region = cover $1.region $2.region in
     EConstr (ConstrApp {region; value = $1, Some $2})
@@ -973,6 +974,17 @@ update_record:
     let value   = {record=$1; kwd_with=$2; updates}
     in {region; value} }
 
+code_insert_expr:
+  "[" "%" Constr expr "]" {
+    let region = cover $1 $5 in
+    let value = {
+                  lbracket =$1;
+                  percent  =$2;
+                  language =$3;
+                  code     =$4;
+                  rbracket =$5}
+    in {region; value} }
+
 field_assignment:
   field_name "=" expr {
     let region = cover $1.region (expr_to_region $3)

src/passes/01-parser/pascaligo/ParserLog.ml

@@ -230,6 +230,14 @@ and print_fun_expr state {value; _} =
   print_token      state kwd_is "is";
   print_expr       state return
 
+and print_code_insert state {value; _} =
+  let {lbracket;percent;language;code;rbracket} : code_insert = value in
+  print_token     state lbracket "[";
+  print_token     state percent  "%";
+  print_string    state language;
+  print_expr      state code;
+  print_token     state rbracket "]"
+
 and print_parameters state {value; _} =
   let {lpar; inside; rpar} = value in
   print_token state lpar "(";
@@ -459,6 +467,7 @@ and print_expr state = function
 | ETuple   e -> print_tuple_expr state e
 | EPar     e -> print_par_expr state e
 | EFun     e -> print_fun_expr state e
+| ECodeInsert e -> print_code_insert state e
 
 and print_annot_expr state node =
   let {inside; _} : annot_expr par = node in
@@ -1010,6 +1019,17 @@ and pp_fun_expr state (expr: fun_expr) =
     pp_expr (state#pad 1 0) expr.return
   in ()
 
+and pp_code_insert state (rc : code_insert) =
+  let () =
+    let state = state#pad 3 0 in
+    pp_node state "<language>";
+    pp_string (state#pad 1 0) rc.language in
+  let () =
+    let state = state#pad 3 1 in
+    pp_node state "<code>";
+    pp_expr (state#pad 1 0) rc.code in
+  ()
+
 and pp_parameters state {value; _} =
   let params = Utils.nsepseq_to_list value.inside in
   let arity  = List.length params in
@@ -1491,6 +1511,9 @@ and pp_expr state = function
 | EFun {value; region} ->
     pp_loc_node state "EFun" region;
     pp_fun_expr state value;
+| ECodeInsert {value; region} -> 
+    pp_loc_node state "ECodeInsert" region;
+    pp_code_insert state value;
 
 and pp_list_expr state = function
   ECons {value; region} ->

src/passes/01-parser/pascaligo/Pretty.ml

@@ -381,6 +381,7 @@ and pp_expr = function
 | ETuple      e -> pp_tuple_expr e
 | EPar        e -> pp_par pp_expr e
 | EFun        e -> pp_fun_expr e
+| ECodeInsert e -> pp_code_insert e
 
 and pp_annot_expr {value; _} =
   let expr, _, type_expr = value.inside in
@@ -495,6 +496,12 @@ and pp_update {value; _} =
   and record  = pp_path record in
   record ^^ string " with" ^^ nest 2 (break 1 ^^ updates)
 
+and pp_code_insert {value; _} =
+  let {language; code; _} = value in
+  let language = pp_string language 
+  and code = pp_expr code in
+  string "[%" ^^ language ^^ string " " ^^ code ^^ string " ]"
+
 and pp_field_path_assign {value; _} =
   let {field_path; field_expr; _} = value in
   let path = pp_path field_path in

src/passes/01-parser/reasonligo/LexToken.mli

@@ -39,6 +39,7 @@ type t =
 | PLUS    of Region.t (* "+" *)
 | SLASH   of Region.t (* "/" *)
 | TIMES   of Region.t (* "*" *)
+| PERCENT of Region.t (* "%" *)
 
   (* Compounds *)
 

src/passes/01-parser/reasonligo/LexToken.mll

@@ -25,6 +25,7 @@ type t =
 | PLUS    of Region.t (* "+" *)
 | SLASH   of Region.t (* "/" *)
 | TIMES   of Region.t (* "*" *)
+| PERCENT of Region.t (* "%" *)
 
   (* Compounds *)
 
@@ -132,6 +133,7 @@ let proj_token = function
 | PLUS     region -> region, "PLUS"
 | SLASH    region -> region, "SLASH"
 | TIMES    region -> region, "TIMES"
+| PERCENT  region -> region, "PERCENT"
 | LPAR     region -> region, "LPAR"
 | RPAR     region -> region, "RPAR"
 | LBRACKET region -> region, "LBRACKET"
@@ -191,6 +193,7 @@ let to_lexeme = function
 | PLUS     _ -> "+"
 | SLASH    _ -> "/"
 | TIMES    _ -> "*"
+| PERCENT  _ -> "%"
 | LPAR     _ -> "("
 | RPAR     _ -> ")"
 | LBRACKET _ -> "["
@@ -429,6 +432,7 @@ let mk_sym lexeme region =
   | "+"  -> Ok (PLUS      region)
   | "/"  -> Ok (SLASH     region)
   | "*"  -> Ok (TIMES     region)
+  | "%"  -> Ok (PERCENT   region)
   | "["  -> Ok (LBRACKET  region)
   | "]"  -> Ok (RBRACKET  region)
   | "{"  -> Ok (LBRACE    region)

src/passes/01-parser/reasonligo/ParToken.mly

@@ -21,6 +21,7 @@
 %token <Region.t> PLUS    "+"
 %token <Region.t> SLASH   "/"
 %token <Region.t> TIMES   "*"
+%token <Region.t> PERCENT "%"
 
 %token <Region.t> LPAR     "("
 %token <Region.t> RPAR     ")"

src/passes/01-parser/reasonligo/Parser.mly

@@ -814,6 +814,7 @@ common_expr:
 | unit                                {                      EUnit $1 }
 | "false"                             {  ELogic (BoolExpr (False $1)) }
 | "true"                              {   ELogic (BoolExpr (True $1)) }
+| code_insert                         {                ECodeInsert $1 }
 
 core_expr_2:
   common_expr   {                   $1 }
@@ -919,6 +920,17 @@ update_record:
       rbrace   = $6}
     in {region; value} }
 
+code_insert:
+  "[" "%" Constr expr "]" {
+    let region = cover $1 $5 in
+    let value = {
+                  lbracket =$1;
+                  percent  =$2;
+                  language =$3;
+                  code     =$4;
+                  rbracket =$5}
+    in {region; value} }
+
 expr_with_let_expr:
   expr
 | let_expr(expr_with_let_expr) { $1 }

src/passes/01-parser/reasonligo/Pretty.ml

@@ -159,6 +159,7 @@ and pp_expr = function
 | ELetIn      e -> pp_let_in e
 | EFun        e -> pp_fun e
 | ESeq        e -> pp_seq e
+| ECodeInsert e -> pp_code_insert e
 
 and pp_case_expr {value; _} =
   let {expr; cases; _} = value in
@@ -319,6 +320,12 @@ and pp_update {value; _} =
   string "{..." ^^ record ^^ string ","
   ^^ nest 2 (break 1 ^^ updates ^^ string "}")
 
+and pp_code_insert {value; _} =
+  let {language; code; _} = value in
+  let language = pp_string language 
+  and code = pp_expr code in
+  string "[%" ^^ language ^^ string " " ^^ code ^^ string " ]"
+
 and pp_field_path_assign {value; _} =
   let {field_path; field_expr; _} = value in
   let path = pp_path field_path in

src/passes/01-parser/shared/Lexer.mll

@@ -314,7 +314,7 @@ let esc        = "\\n" | "\\\"" | "\\\\" | "\\b"
 
 let common_sym     =   ';' | ',' | '(' | ')'  | '[' | ']'  | '{' | '}'
                      | '=' | ':' | '|' | "->" | '.' | '_'  | '^'
-                     | '+' | '-' | '*' | '/'  | '<' | "<=" | '>' | ">="
+                     | '+' | '-' | '*' | '/'  | '%' | '<' | "<=" | '>' | ">="
 let pascaligo_sym  = "=/=" | '#' | ":="
 let cameligo_sym   = "<>" | "::" | "||" | "&&"
 let reasonligo_sym = '!' | "=>" | "!=" | "==" | "++" | "..." | "||" | "&&"

src/passes/02-concrete_to_imperative/cameligo.ml

@@ -638,6 +638,12 @@ in trace (abstracting_expr t) @@
       let%bind match_false = compile_expression c.ifnot in
       return @@ e_cond ~loc expr match_true match_false
     )
+  | ECodeInsert ci -> (
+      let (ci, loc) = r_split ci in
+      let      language  = ci.language.value in
+      let%bind code      = compile_expression ci.code in
+      return @@ e_raw_code ~loc language code
+    )
 
 and compile_fun lamb' : expr result =
   let return x = ok x in

src/passes/02-concrete_to_imperative/pascaligo.ml

@@ -459,6 +459,12 @@ let rec compile_expression (t:Raw.expr) : expr result =
     let (f , loc) = r_split f in
     let%bind (_ty_opt, f') = compile_fun_expression ~loc f
     in return @@ f'
+  | ECodeInsert ci ->
+    let (ci, loc) = r_split ci in
+    let      language  = ci.language.value in
+    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
   let name, path = compile_path u.record in

src/passes/03-self_ast_imperative/helpers.ml

@@ -21,7 +21,7 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   let self = fold_expression f in 
   let%bind init' = f init e in
   match e.expression_content with
-  | E_literal _ | E_variable _ | E_skip -> ok init'
+  | E_literal _ | E_variable _ | E_raw_code _ | E_skip -> ok init'
   | E_list lst | E_set lst | E_constant {arguments=lst} -> (
     let%bind res = bind_fold_list self init' lst in
     ok res
@@ -261,7 +261,7 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       let%bind body = self body in
       return @@ E_while {condition; body}
 
-  | E_literal _ | E_variable _ | E_skip as e' -> return e'
+  | E_literal _ | E_variable _ | E_raw_code _ | E_skip as e' -> return e'
 
 and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
   let self = map_type_expression f in
@@ -450,7 +450,7 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind res,condition = self init' condition in
       let%bind res,body = self res body in
       ok (res, return @@ E_while {condition; body})
-  | E_literal _ | E_variable _ | E_skip as e' -> ok (init', return e')
+  | E_literal _ | E_variable _ | E_raw_code _ | E_skip as e' -> ok (init', return e')
 
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with

src/passes/04-imperative_to_sugar/imperative_to_sugar.ml

@@ -57,7 +57,7 @@ let repair_mutable_variable_in_matching (match_body : O.expression) (element_nam
       | E_constant _
       | E_skip
       | E_literal _ | E_variable _
-      | E_application _ | E_lambda _| E_recursive _
+      | E_application _ | E_lambda _| E_recursive _ | E_raw_code _
       | E_constructor _ | E_record _| E_accessor _|E_update _
       | E_ascription _  | E_sequence _ | E_tuple _
       | E_map _ | E_big_map _ |E_list _ | E_set _
@@ -100,7 +100,7 @@ and repair_mutable_variable_in_loops (for_body : O.expression) (element_names :
       | E_constant _
       | E_skip
       | E_literal _ | E_variable _
-      | E_application _ | E_lambda _| E_recursive _
+      | E_application _ | E_lambda _| E_recursive _ | E_raw_code _
       | E_constructor _ | E_record _| E_accessor _| E_update _
       | E_ascription _  | E_sequence _ | E_tuple _
       | E_map _ | E_big_map _ |E_list _ | E_set _
@@ -218,6 +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} ->
+      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
@@ -613,6 +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} ->
+    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}

src/passes/05-self_ast_sugar/helpers.ml

@@ -21,7 +21,7 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   let self = fold_expression f in 
   let%bind init' = f init e in
   match e.expression_content with
-  | E_literal _ | E_variable _ | E_skip -> ok init'
+  | E_literal _ | E_variable _ | E_raw_code _ | E_skip -> ok init'
   | E_list lst | E_set lst | E_constant {arguments=lst} -> (
     let%bind res = bind_fold_list self init' lst in
     ok res
@@ -231,7 +231,7 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
     let%bind t' = bind_map_list self t in
     return @@ E_tuple t'
   )
-  | E_literal _ | E_variable _ | E_skip as e' -> return e'
+  | E_literal _ | E_variable _ | E_raw_code _ | E_skip as e' -> return e'
 
 and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
   let self = map_type_expression f in
@@ -403,7 +403,8 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res,(expr1,expr2)) = bind_fold_map_pair self init' (expr1,expr2) in
       ok (res, return @@ E_sequence {expr1;expr2})
     )
-  | E_literal _ | E_variable _ | E_skip as e' -> ok (init', return e')
+  | E_literal _ | E_variable _ | E_raw_code _ | E_skip as e' -> ok (init', return e')
+
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with
   | Match_variant lst -> (

src/passes/06-sugar_to_core/sugar_to_core.ml

@@ -71,6 +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} ->
+      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}
@@ -328,6 +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} ->
+    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}

src/passes/07-self_ast_core/helpers.ml

@@ -24,7 +24,7 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   let self = fold_expression f in 
   let%bind init' = f init e in
   match e.expression_content with
-  | E_literal _ | E_variable _ -> ok init'
+  | E_literal _ | E_variable _ | E_raw_code _ -> ok init'
   | E_constant {arguments=lst} -> (
     let%bind res = bind_fold_list self init' lst in
     ok res
@@ -148,7 +148,7 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
       let%bind args = bind_map_list self c.arguments in
       return @@ E_constant {c with arguments=args}
     )
-  | E_literal _ | E_variable _ as e' -> return e'
+  | E_literal _ | E_variable _ | E_raw_code _ as e' -> return e'
 
 and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f ({type_content ; location ; type_meta} as te) ->
   let self = map_type_expression f in
@@ -262,7 +262,7 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res,args) = bind_fold_map_list self init' c.arguments in
       ok (res, return @@ E_constant {c with arguments=args})
     )
-  | E_literal _ | E_variable _ as e' -> ok (init', return e')
+  | E_literal _ | E_variable _ | E_raw_code _ as e' -> ok (init', return e')
 
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with

src/passes/08-typer-new/typer.ml

@@ -332,7 +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} ->
+    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

src/passes/08-typer-new/untyper.ml

@@ -282,6 +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} ->
+    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

src/passes/08-typer-new/wrap.ml

@@ -307,6 +307,14 @@ let recursive : T.type_expression -> (constraints * T.type_variable) =
       c_equation fun_type ({ tsrc = "wrap: recursive: whole" ; t = P_variable whole_expr }) "wrap: recursive: fun_type (whole)" ;
   ], whole_expr
 
+let raw_code : T.type_expression -> (constraints * T.type_variable) =
+  fun type_anno -> 
+  let type_anno = type_expression_to_type_value type_anno in
+  let whole_expr = Core.fresh_type_variable () in
+  [
+      c_equation type_anno  ({ tsrc = "wrap: raw_code: whole"; t = P_variable whole_expr }) "wrap: raw_code: type_anno (whole)" ;
+  ], whole_expr
+
 let assign : T.type_expression -> T.type_expression -> (constraints * T.type_variable) =
   fun v e ->
   let v' = type_expression_to_type_value v in

src/passes/08-typer-old/typer.ml

@@ -936,6 +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} ->
+    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
@@ -1072,6 +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} ->
+      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

src/passes/09-self_ast_typed/helpers.ml

@@ -7,7 +7,7 @@ let rec fold_expression : 'a . 'a folder -> 'a -> expression -> 'a result = fun
   let self = fold_expression f in 
   let%bind init' = f init e in
   match e.expression_content with
-  | E_literal _ | E_variable _ -> ok init'
+  | E_literal _ | E_variable _ | E_raw_code _ -> ok init'
   | E_constant {arguments=lst} -> (
     let%bind res = bind_fold_list self init' lst in
     ok res
@@ -121,7 +121,7 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
       let%bind args = bind_map_list self c.arguments in
       return @@ E_constant {c with arguments=args}
     )
-  | E_literal _ | E_variable _ as e' -> return e'
+  | E_literal _ | E_variable _ | E_raw_code _ as e' -> return e'
 
 
 and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
@@ -209,7 +209,7 @@ let rec fold_map_expression : 'a . 'a fold_mapper -> 'a -> expression -> ('a * e
       let%bind (res,args) = bind_fold_map_list self init' c.arguments in
       ok (res, return @@ E_constant {c with arguments=args})
     )
-  | E_literal _ | E_variable _ as e' -> ok (init', return e')
+  | E_literal _ | E_variable _ | E_raw_code _ as e' -> ok (init', return e')
 
 and fold_map_cases : 'a . 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with

src/passes/09-self_ast_typed/tail_recursion.ml

@@ -38,6 +38,8 @@ let rec check_recursive_call : expression_variable -> bool -> expression -> unit
     let%bind _ = check_recursive_call n false rhs in
     let%bind _ = check_recursive_call n final_path let_result in
     ok ()
+  | E_raw_code _ ->
+    ok ()
   | E_constructor {element;_} ->
     let%bind _ = check_recursive_call n false element in
     ok ()

src/passes/10-interpreter/interpreter.ml

@@ -365,6 +365,7 @@ and eval : Ast_typed.expression -> env -> value result
     )
     | E_recursive {fun_name; fun_type=_; lambda} ->
       ok @@ V_Func_rec (fun_name, lambda.binder, lambda.result, env)
+    | E_raw_code _ -> simple_fail "Can't evaluate a raw code insertion"
 
 let dummy : Ast_typed.program -> string result =
   fun prg ->

src/passes/10-transpiler/transpiler.ml

@@ -92,6 +92,15 @@ them. please report this to the developers." in
     ] in
     error ~data title content
 
+  let language_backend_mismatch language backend =
+    let title () = "Language insert - Backend Mismatch" in
+    let content () = "only provide code insertion in the language you are compiling to" in
+    let data = [
+      ("Code Insertion Language", fun () -> language);
+      ("Target backend", fun () -> backend);
+    ] in
+    error ~data title content
+
 
 end
 open Errors
@@ -606,6 +615,16 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
           aux expr' tree''
        )
   )
+  | E_raw_code { language; code} -> 
+    let backend = "Michelson" in
+    let%bind () =
+      trace_strong (language_backend_mismatch language backend) @@
+      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_string code in
+    return ~tv:type_anno' @@ E_raw_michelson code
 
 and transpile_lambda l (input_type , output_type) =
   let { binder ; result } : AST.lambda = l in

src/passes/11-self_mini_c/helpers.ml

@@ -25,6 +25,7 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   let%bind init' = f init e in
   match e.content with
   | E_variable _ | E_skip | E_make_none _
+  | E_raw_michelson _
   | E_literal _ -> ok init'
   | E_constant (c) -> (
       let%bind res = bind_fold_list self init' c.arguments in
@@ -87,7 +88,7 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
   let%bind e' = f e in
   let return content = ok { e' with content } in
   match e'.content with
-  | E_variable _ | E_literal _ | E_skip | E_make_none _
+  | E_variable _ | E_literal _ | E_skip | E_make_none _ | E_raw_michelson _
     as em -> return em
   | E_constant (c) -> (
       let%bind lst = bind_map_list self c.arguments in

src/passes/11-self_mini_c/self_mini_c.ml

@@ -49,6 +49,7 @@ let rec is_pure : expression -> bool = fun e ->
   | E_skip
   | E_variable _
   | E_make_none _
+  | E_raw_michelson _
     -> true
 
   | E_if_bool (cond, bt, bf)

src/passes/11-self_mini_c/subst.ml

@@ -94,6 +94,7 @@ let rec replace : expression -> var_name -> var_name -> expression =
     let cond = replace cond in
     let body = replace body in
     return @@ E_while (cond, body)
+  | E_raw_michelson _ -> e
 
 (**
    Computes `body[x := expr]`.
@@ -169,7 +170,7 @@ let rec subst_expression : body:expression -> x:var_name -> expr:expression -> e
     return @@ E_if_left (c, ((name_l, tvl) , l), ((name_r, tvr) , r))
   )
   (* All that follows is boilerplate *)
-  | E_literal _ | E_skip | E_make_none _
+  | E_literal _ | E_skip | E_make_none _ | E_raw_michelson _
     as em -> return em
   | E_constant (c) -> (
       let lst = List.map self c.arguments in

src/passes/12-compiler/compiler_program.ml

@@ -23,6 +23,16 @@ them. please report this to the developers." in
       [ ("location", fun () -> loc) ;
       ] in
     error ~data title content
+
+  let raw_michelson_parsing_error code =
+    let title () = "Error while parsing Michelson code insertion" in
+    let content () = "Unable to parse the michelson code" in
+    let data = [ 
+      ("code", fun () -> code);
+      (* TODO : add location in Mini-c *)
+      (* ("location", fun () -> Format.asprintf "%a" Location.pp location); *)
+    ] in
+    error ~data title content
 end
 open Errors
 
@@ -483,6 +493,15 @@ and translate_expression (expr:expression) (env:environment) : michelson result
         i_push_unit ;
       ]
     )
+  | E_raw_michelson code -> 
+      let%bind code = 
+        Proto_alpha_utils.Trace.trace_tzresult (raw_michelson_parsing_error code) @@
+        Tezos_micheline.Micheline_parser.no_parsing_error @@ 
+        Michelson_parser.V1.parse_expression ~check:false code
+      in
+      let code = Tezos_micheline.Micheline.root code.expanded in
+      let%bind ty = Compiler_type.type_ ty 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

src/passes/13-self_michelson/self_michelson.ml

@@ -474,7 +474,6 @@ let rec opt_strip_annots (x : michelson) : michelson =
 
 let optimize : michelson -> michelson =
   fun x ->
-  let x = use_lambda_instr x in
   let x = flatten_seqs x in
   let x = opt_tail_fail x in
   let optimizers = [ peephole @@ peep2 opt_drop2 ;
@@ -487,4 +486,5 @@ let optimize : michelson -> michelson =
   let x = iterate_optimizer (sequence_optimizers optimizers) x in
   let x = opt_combine_drops x in
   let x = opt_strip_annots x in
+  let x = use_lambda_instr x in
   x

src/stages/1-ast_imperative/PP.ml

@@ -113,6 +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} ->
+      fprintf ppf "[%%%s %a]" language expression code
   | E_ascription {anno_expr; type_annotation} ->
       fprintf ppf "%a : %a" expression anno_expr type_expression
         type_annotation

src/stages/1-ast_imperative/combinators.ml

@@ -115,6 +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 = 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}

src/stages/1-ast_imperative/combinators.mli

@@ -95,6 +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 -> expression -> expression
 
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression

src/stages/1-ast_imperative/types.ml

@@ -48,6 +48,7 @@ and expression_content =
   | E_lambda of lambda
   | E_recursive of recursive
   | E_let_in of let_in
+  | E_raw_code of raw_code
   (* Variant *)
   | E_constructor of constructor (* For user defined constructors *)
   | E_matching of matching
@@ -100,6 +101,11 @@ and let_in =
   ; let_result: expression
   ; inline: bool }
 
+and raw_code = { 
+  language : string ;
+  code : expression ;
+  }
+
 and constructor = {constructor: constructor'; element: expression}
 
 and accessor = {record: expression; path: access list}

src/stages/2-ast_sugar/PP.ml

@@ -112,6 +112,8 @@ and expression_content ppf (ec : expression_content) =
         expression rhs 
         option_inline inline 
         expression let_result
+  | 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} ->

src/stages/2-ast_sugar/combinators.ml

@@ -103,6 +103,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) 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_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}

src/stages/2-ast_sugar/combinators.mli

@@ -77,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

src/stages/2-ast_sugar/types.ml

@@ -49,6 +49,7 @@ and expression_content =
   | E_lambda of lambda
   | E_recursive of recursive
   | E_let_in of let_in
+  | E_raw_code of raw_code
   (* Variant *)
   | E_constructor of constructor (* For user defined constructors *)
   | E_matching of matching
@@ -98,6 +99,11 @@ and let_in = {
   mut: bool;
   }
 
+and raw_code = { 
+  language : string ;
+  code : expression ;
+  }
+
 and constructor = {constructor: constructor'; element: expression}
 
 and accessor = {record: expression; path: access list}

src/stages/3-ast_core/PP.ml

@@ -48,6 +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} ->
+      fprintf ppf "[%%%s %a]" language expression code
   | E_ascription {anno_expr; type_annotation} ->
       fprintf ppf "%a : %a" expression anno_expr type_expression
         type_annotation

src/stages/3-ast_core/combinators.ml

@@ -102,6 +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 = 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}
@@ -163,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

src/stages/3-ast_core/combinators.mli

@@ -77,6 +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 -> 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
@@ -100,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

src/stages/3-ast_core/misc.ml

@@ -140,6 +140,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | (_a' , E_ascription b) -> assert_value_eq (a , b.anno_expr)
   | (E_variable _, _) | (E_lambda _, _)
   | (E_application _, _) | (E_let_in _, _)
+  | (E_raw_code _, _)
   | (E_recursive _,_) | (E_record_accessor _, _)
   | (E_matching _, _)
   -> simple_fail "comparing not a value"

src/stages/3-ast_core/types.ml

@@ -34,6 +34,7 @@ and expression_content =
   | E_lambda of lambda
   | E_recursive of recursive
   | E_let_in of let_in
+  | E_raw_code of raw_code
   (* Variant *)
   | E_constructor of constructor (* For user defined constructors *)
   | E_matching of matching
@@ -71,6 +72,11 @@ and let_in =
   ; let_result: expression
   ; inline: bool }
 
+and raw_code = { 
+  language : string ;
+  code : expression ;
+  }
+
 and constructor = {constructor: constructor'; element: expression}
 
 and record_accessor = {record: expression; path: label}

src/stages/4-ast_typed/PP.ml

@@ -291,6 +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} ->
+      fprintf ppf "[%%%s %a]" language expression code
   | E_recursive { fun_name;fun_type; lambda} ->
       fprintf ppf "rec (%a:%a => %a )" 
         expression_variable fun_name 

src/stages/4-ast_typed/ast.ml

@@ -314,6 +314,7 @@ and expression_content =
   | E_lambda of lambda
   | E_recursive of recursive
   | E_let_in of let_in
+  | E_raw_code of raw_code
   (* Variant *)
   | E_constructor of constructor (* For user defined constructors *)
   | E_matching of matching
@@ -346,6 +347,11 @@ and let_in = {
     inline : bool ;
   }
 
+and raw_code = {
+  language : string;
+  code : expression;
+}
+
 and recursive = {
   fun_name : expression_variable;
   fun_type : type_expression;

src/stages/4-ast_typed/combinators.ml

@@ -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 ()

src/stages/4-ast_typed/combinators.mli

@@ -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

src/stages/4-ast_typed/compute_environment.ml

@@ -45,6 +45,7 @@ let rec expression : environment -> expression -> expression = fun env expr ->
     let (lamb , args) = self_2 c.lamb c.args in
     return @@ E_application { lamb ; args }
   )
+  | E_raw_code _ -> return_id
   | E_constructor c -> (
     let element = self c.element in
     return @@ E_constructor { c with element }

src/stages/4-ast_typed/misc.ml

@@ -218,6 +218,7 @@ module Free_variables = struct
       union
         (expression b' let_result)
         (self rhs)
+    | E_raw_code _ -> empty
     | E_recursive {fun_name;lambda;_} ->
       let b' = union (singleton fun_name) b in
       expression_content b' @@ E_lambda lambda
@@ -491,7 +492,7 @@ let rec assert_value_eq (a, b: (expression*expression)) : unit result =
       fail @@ (different_values_because_different_types "record vs. non-record" a b)
 
   | (E_literal _, _) | (E_variable _, _) | (E_application _, _)
-  | (E_lambda _, _) | (E_let_in _, _) | (E_recursive _, _)
+  | (E_lambda _, _) | (E_let_in _, _) | (E_raw_code _, _) | (E_recursive _, _)
   | (E_record_accessor _, _) | (E_record_update _,_)
   | (E_matching _, _)
   -> fail @@ error_uncomparable_values "can't compare sequences nor loops" a b

src/stages/4-ast_typed/misc_smart.ml

@@ -73,6 +73,7 @@ module Captured_variables = struct
     | E_let_in li ->
       let b' = union (singleton li.let_binder) b in
       expression b' li.let_result
+    | E_raw_code _ -> ok empty
     | E_recursive r -> 
       let b' = union (singleton r.fun_name) b in
       expression_content b' @@ E_lambda r.lambda

src/stages/5-mini_c/PP.ml

@@ -47,7 +47,7 @@ and type_constant ppf (tb:type_base) : unit =
     | TB_chain_id  -> "chain_id"
     | TB_void      -> "void"
     in
-  fprintf ppf "(TC %s)" s
+  fprintf ppf "%s" s
 
 let rec value ppf : value -> unit = function
   | D_bool b -> fprintf ppf "%b" b
@@ -70,6 +70,21 @@ 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_expression_annotated ppf : type_expression annotated -> unit = fun (_, tv) ->
+  type_expression ppf tv
+
+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_expression k type_expression v
+  | T_big_map (k,v) -> fprintf ppf "Big_map (%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
 
@@ -110,6 +125,8 @@ and expression_content ppf (e:expression_content) = match e with
       fprintf ppf "@[{ %a@;<1 2>with@;<1 2>{ %a = %a } }@]" expression r (list_sep lr (const ".")) path expression update
   | E_while (e , b) ->
       fprintf ppf "@[while %a do %a@]" expression e expression b
+  | E_raw_michelson code ->
+      fprintf ppf "%s" code 
 
 and expression_with_type : _ -> expression -> _  = fun ppf e ->
   fprintf ppf "%a : %a"

src/stages/5-mini_c/PP.mli

@@ -12,6 +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_expression : formatter -> type_expression -> unit
 
 (*
 val value_assoc : formatter -> (value * value) -> unit

src/stages/5-mini_c/misc.ml

@@ -77,6 +77,7 @@ module Free_variables = struct
     | E_sequence (x, y) -> union (self x) (self y)
     | E_record_update (r, _,e) -> union (self r) (self e)
     | E_while (cond , body) -> union (self cond) (self body)
+    | E_raw_michelson _ -> empty
 
   and var_name : bindings -> var_name -> bindings = fun b n ->
     if mem n b

src/stages/5-mini_c/types.ml

@@ -91,6 +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
 
 and expression = {
   content : expression_content ;

src/stages/typesystem/misc.ml

@@ -159,6 +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} ->
+        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

src/test/contracts/michelson_insertion.ligo

@@ -0,0 +1,5 @@
+// Test michelson insertion in PascaLIGO
+
+function michelson_add (var n : nat * nat ) : nat is block {
+  const f : (nat * nat -> nat)= [%Michelson ({| { UNPAIR; ADD } |} : nat *nat -> nat)];
+} with f (n)

src/test/contracts/michelson_insertion.mligo

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

src/test/contracts/michelson_insertion.religo

@@ -0,0 +1,4 @@
+// Test michelson insertion in ReasonLIGO
+
+let michelson_add = (n : (nat, nat)) : nat =>
+  [%Michelson ({| { UNPAIR;ADD } |} : ((nat, nat) => nat)) ](n);

src/test/contracts/negative/bad_michelson_insertion_1.ligo

@@ -0,0 +1,5 @@
+// Test michelson insertion in PascaLIGO
+
+function main (const p : nat; const s: nat ) : list (operation)* nat is block {
+  const f : (nat * nat -> nat)= [%Michelson ({| ADD |} : nat *nat -> nat)];
+} with ((nil: list(operation)), f (p, s))

src/test/contracts/negative/bad_michelson_insertion_2.ligo

@@ -0,0 +1,5 @@
+// Test michelson insertion in PascaLIGO
+
+function main (const p : nat; const s: nat ) : list (operation)* nat is block {
+  const f : (nat -> nat -> nat)= [%Michelson ({| ADD |} : nat -> nat -> nat)];
+} with ((nil: list(operation)), f (p, s))

src/test/contracts/negative/bad_michelson_insertion_3.ligo

@@ -0,0 +1,5 @@
+// Test michelson insertion in PascaLIGO
+
+function main (const p : nat; const s: nat ) : list (operation)* nat is block {
+  const f : (nat * nat -> nat)= [%Michelson (" { UNPAIR; ADD } " : nat * nat -> nat)];
+} with ((nil: list(operation)), f (p, s))

src/test/integration_tests.ml

@@ -1759,6 +1759,21 @@ let fibo_mligo () : unit result =
   let make_expected = (e_int 42) in
   expect_eq program "main" make_input make_expected
 
+let michelson_insertion program : unit result =
+  let%bind program = program in
+  let make_input = fun n -> e_pair (e_nat n) (e_nat 1) in
+  let make_expected = fun n -> e_nat (n+1) in
+  expect_eq_n_pos program "michelson_add" make_input make_expected
+
+let michelson_insertion_ligo () : unit result =
+  michelson_insertion @@ type_file "./contracts/michelson_insertion.ligo"
+
+let michelson_insertion_mligo () : unit result =
+  michelson_insertion @@ mtype_file "./contracts/michelson_insertion.mligo"
+
+let michelson_insertion_religo () : unit result =
+  michelson_insertion @@ retype_file "./contracts/michelson_insertion.religo"
+
 let website1_ligo () : unit result =
   let%bind program = type_file "./contracts/website1.ligo" in
   let make_input = fun n-> e_pair (e_int n) (e_int 42) in
@@ -2519,6 +2534,9 @@ let main = test_suite "Integration (End to End)" [
     (* test "fibo2 (mligo)" fibo2_mligo ; *)
     (* test "fibo3 (mligo)" fibo3_mligo ; *)
     (* test "fibo4 (mligo)" fibo4_mligo ; *)
+    test "michelson inserion ligo" michelson_insertion_ligo;
+    test "michelson inserion mligo" michelson_insertion_mligo;
+    test "michelson inserion religo" michelson_insertion_religo;
     test "website1 ligo" website1_ligo ;
     test "website2 ligo" website2_ligo ;
     test "website2 (mligo)" website2_mligo ;