generating good code

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

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

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

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

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

@@ -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_expr      state code;
-  print_token     state colon ":";
-  print_type_expr state type_anno;
   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
+    pp_expr (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 ()
 
 and pp_let_in state node =
   let {binding; body; attributes; kwd_rec; _} = node in

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

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

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

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

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

@@ -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_expr      state code;
-  print_token     state colon ":";
-  print_type_expr state type_anno;
   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
+    pp_expr (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 ()
 
 and pp_parameters state {value; _} =
   let params = Utils.nsepseq_to_list value.inside in

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

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

src/passes/02-concrete_to_imperative/cameligo.ml

@@ -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 code      = compile_expression ci.code in
-      let%bind type_anno = compile_type_expression ci.type_anno in
+      return @@ e_raw_code ~loc language code
-      return @@ e_raw_code ~loc language code type_anno
     )
 
 and compile_fun lamb' : expr result =

src/passes/02-concrete_to_imperative/pascaligo.ml

@@ -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 code      = compile_expression ci.code in
-    let%bind type_anno = compile_type_expression ci.type_anno in
+    return @@ e_raw_code ~loc language code
-    return @@ e_raw_code ~loc language code type_anno
 
 and compile_update (u: Raw.update Region.reg) =
   let u, loc     = r_split u in

src/passes/04-imperative_to_sugar/imperative_to_sugar.ml

@@ -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} ->
+    | I.E_raw_code {language;code} ->
-      let%bind type_anno  = compile_type_expression type_anno in
+      let%bind code = compile_expression code in
-      return @@ O.e_raw_code ~loc language code type_anno
+      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} ->
+  | O.E_raw_code {language;code} ->
-    let%bind type_anno  = uncompile_type_expression type_anno in
+    let%bind code  = uncompile_expression' code in
-    return @@ I.E_raw_code {language;code;type_anno} 
+    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/06-sugar_to_core/sugar_to_core.ml

@@ -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} ->
+    | I.E_raw_code {language;code} ->
-      let%bind type_anno = compile_type_expression type_anno in
+      let%bind code = compile_expression code in
-      return @@ O.E_raw_code {language;code;type_anno} 
+      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} ->
+  | O.E_raw_code {language;code} ->
-    let%bind type_anno = uncompile_type_expression type_anno in
+    let%bind code = uncompile_expression code in
-    return @@ I.E_raw_code {language;code;type_anno} 
+    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/08-typer-new/typer.ml

@@ -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} ->
+  | E_raw_code {language ; code} ->
-    let%bind type_anno = evaluate_type e type_anno in
+    let%bind (code,state') = type_expression e state code in
-    let wrapped = Wrap.raw_code type_anno in
+    let wrapped = Wrap.raw_code code.type_expression in
-    return_wrapped (E_raw_code {language; code ;type_anno}) state wrapped
+    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,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} ->
+  | E_raw_code {language; code} ->
-    let%bind type_anno = untype_type_expression type_anno in
+    let%bind code = untype_expression code in
-    return @@ e_raw_code language code type_anno
+    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-old/typer.ml

@@ -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} ->
+  | E_raw_code {language;code} ->
-    let%bind type_anno = evaluate_type e type_anno in
+    let%bind (code,type_expression) = I.get_e_ascription code.expression_content in
-    let%bind (_input_type,_output_type) = get_t_function type_anno in
+    let%bind code = type_expression' e code in
-    return (E_raw_code {language;code;type_anno}) type_anno
+    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} ->
+  | E_raw_code {language; code} ->
-      let%bind type_anno = untype_type_expression type_anno in
+      let%bind code = untype_expression code in
-      return (e_raw_code language code type_anno)
+      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/10-transpiler/transpiler.ml

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

src/passes/12-compiler/compiler_program.ml

@@ -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
+      let%bind ty = Compiler_type.type_ type_anno in
-
+      return @@ i_push ty code
-  return @@ Michelson.prim ~children:[code] ~annot:[annot] I_PUSH
 
 and translate_function_body ({body ; binder} : anon_function) lst input : michelson result =
   let pre_env = Environment.of_list lst in

src/stages/1-ast_imperative/PP.ml

@@ -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} ->
+  | E_raw_code {language; code} ->
-      fprintf ppf "[%%%s {%s} : %a]" language code type_expression type_anno
+      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,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}

src/stages/1-ast_imperative/combinators.mli

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

src/stages/1-ast_imperative/types.ml

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

src/stages/2-ast_sugar/PP.ml

@@ -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} ->
+  | E_raw_code {language; code} ->
-      fprintf ppf "[%%%s {%s} : %a]" language code type_expression type_anno
+      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,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}
 

src/stages/2-ast_sugar/combinators.mli

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

src/stages/2-ast_sugar/types.ml

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

src/stages/3-ast_core/PP.ml

@@ -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} ->
+  | E_raw_code {language; code} ->
-      fprintf ppf "[%%%s {%s} : %a]" language code type_expression type_anno
+      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,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

src/stages/3-ast_core/combinators.mli

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

src/stages/3-ast_core/types.ml

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

src/stages/4-ast_typed/PP.ml

@@ -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} ->
+  | E_raw_code {language; code} ->
-      fprintf ppf "[%%%s {%s} : %a]" language code type_expression type_anno
+      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/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/5-mini_c/PP.ml

@@ -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) ->
+and type_expression_annotated ppf : type_expression annotated -> unit = fun (_, tv) ->
-  type_value ppf tv
+  type_expression ppf tv
 
-and type_value ppf : type_value -> unit = function
+and type_expression ppf : type_expression -> unit = fun te -> match te.type_content with
-  | T_pair (a,b) -> fprintf ppf "pair %a %a" type_value_annotated a type_value_annotated b
+  | 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_value_annotated a type_value_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_value a type_value 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_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_value k type_value 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_value e
+  | T_list e -> fprintf ppf "List (%a)" type_expression e
-  | T_set e -> fprintf ppf "Set (%a)" type_value e
+  | T_set e -> fprintf ppf "Set (%a)" type_expression e
-  | T_contract c -> fprintf ppf "Contract (%a)" type_value c
+  | T_contract c -> fprintf ppf "Contract (%a)" type_expression c
-  | T_option c -> fprintf ppf "Option (%a)" type_value 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

src/stages/5-mini_c/PP.mli

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

src/stages/5-mini_c/types.ml

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

src/stages/typesystem/misc.ml

@@ -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} ->
+      | T.E_raw_code {language; code} ->
-        let%bind type_anno = s_type_expression ~substs type_anno in
+        let%bind code = s_expression ~substs code in
-        ok @@ T.E_raw_code {language; code; type_anno}
+        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.mligo

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