diff --git a/src/passes/01-parser/cameligo/AST.ml b/src/passes/01-parser/cameligo/AST.ml index db425d540..56321474d 100644 --- a/src/passes/01-parser/cameligo/AST.ml +++ b/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 = { + language : string reg; + code : string reg; + colon : colon; + type_anno : type_expr; + rbracket : rbracket; +} (* Projecting regions from some nodes of the AST *) let rec last to_region = function @@ -477,11 +486,12 @@ let expr_to_region = function | EString e -> string_expr_to_region e | EList e -> list_expr_to_region e | EConstr e -> constr_expr_to_region e -| EAnnot {region;_ } | ELetIn {region;_} | EFun {region;_} -| 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 +| EAnnot {region;_ } | ELetIn {region;_} | EFun {region;_} +| ECond {region;_} | ETuple {region;_} | ECase {region;_} +| ECall {region;_} | EVar {region; _} | EProj {region; _} +| EUnit {region;_} | EPar {region;_} | EBytes {region; _} +| ESeq {region; _} | ERecord {region; _} | EUpdate {region; _} +| ECodeInsert {region; _} -> region let selection_to_region = function FieldName f -> f.region diff --git a/src/passes/01-parser/cameligo/LexToken.mli b/src/passes/01-parser/cameligo/LexToken.mli index fabddb2fa..65c8ff340 100644 --- a/src/passes/01-parser/cameligo/LexToken.mli +++ b/src/passes/01-parser/cameligo/LexToken.mli @@ -38,10 +38,10 @@ type t = (* Arithmetics *) -| MINUS of Region.t (* "-" *) -| PLUS of Region.t (* "+" *) -| SLASH of Region.t (* "/" *) -| TIMES of Region.t (* "*" *) +| MINUS of Region.t (* "-" *) +| PLUS of Region.t (* "+" *) +| SLASH of Region.t (* "/" *) +| TIMES of Region.t (* "*" *) (* Compounds *) @@ -87,28 +87,29 @@ type t = | Verbatim of string Region.reg | Bytes of (string * Hex.t) Region.reg | Attr of string Region.reg +| Insert of string Region.reg (* Keywords *) (*| And*) -| Begin of Region.t -| Else of Region.t -| End of Region.t -| False of Region.t -| Fun of Region.t -| Rec of Region.t -| If of Region.t -| In of Region.t -| Let of Region.t -| Match of Region.t -| Mod of Region.t -| Not of Region.t -| Of of Region.t -| Or of Region.t -| Then of Region.t -| True of Region.t -| Type of Region.t -| With of Region.t +| Begin of Region.t +| Else of Region.t +| End of Region.t +| False of Region.t +| Fun of Region.t +| Rec of Region.t +| If of Region.t +| In of Region.t +| Let of Region.t +| Match of Region.t +| Mod of Region.t +| Not of Region.t +| Of of Region.t +| Or of Region.t +| Then of Region.t +| True of Region.t +| Type of Region.t +| With of Region.t (* Data constructors *) @@ -154,6 +155,7 @@ val mk_verbatim : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result +val mk_insert : lexeme -> Region.t -> token val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/01-parser/cameligo/LexToken.mll b/src/passes/01-parser/cameligo/LexToken.mll index 7d54d440b..c57e3076e 100644 --- a/src/passes/01-parser/cameligo/LexToken.mll +++ b/src/passes/01-parser/cameligo/LexToken.mll @@ -22,10 +22,10 @@ type t = (* Arithmetics *) -| MINUS of Region.t (* "-" *) -| PLUS of Region.t (* "+" *) -| SLASH of Region.t (* "/" *) -| TIMES of Region.t (* "*" *) +| MINUS of Region.t (* "-" *) +| PLUS of Region.t (* "+" *) +| SLASH of Region.t (* "/" *) +| TIMES of Region.t (* "*" *) (* Compounds *) @@ -71,28 +71,29 @@ type t = | Verbatim of string Region.reg | Bytes of (string * Hex.t) Region.reg | Attr of string Region.reg +| Insert of string Region.reg (* Keywords *) (*| And*) -| Begin of Region.t -| Else of Region.t -| End of Region.t -| False of Region.t -| Fun of Region.t -| Rec of Region.t -| If of Region.t -| In of Region.t -| Let of Region.t -| Match of Region.t -| Mod of Region.t -| Not of Region.t -| Of of Region.t -| Or of Region.t -| Then of Region.t -| True of Region.t -| Type of Region.t -| With of Region.t +| Begin of Region.t +| Else of Region.t +| End of Region.t +| False of Region.t +| Fun of Region.t +| Rec of Region.t +| If of Region.t +| In of Region.t +| Let of Region.t +| Match of Region.t +| Mod of Region.t +| Not of Region.t +| Of of Region.t +| Or of Region.t +| Then of Region.t +| True of Region.t +| Type of Region.t +| With of Region.t (* Data constructors *) @@ -130,6 +131,8 @@ let proj_token = function region, sprintf "Constr %s" value | Attr Region.{region; value} -> region, sprintf "Attr \"%s\"" value +| Insert Region.{region; value} -> + region, sprintf "Insert \"%s\"" value (* Symbols *) @@ -204,6 +207,7 @@ let to_lexeme = function | Ident id -> id.Region.value | Constr id -> id.Region.value | Attr a -> a.Region.value +| Insert i -> i.Region.value (* Symbols *) @@ -277,24 +281,24 @@ let to_region token = proj_token token |> fst (* LEXIS *) let keywords = [ - (fun reg -> Begin reg); - (fun reg -> Else reg); - (fun reg -> End reg); - (fun reg -> False reg); - (fun reg -> Fun reg); - (fun reg -> Rec reg); - (fun reg -> If reg); - (fun reg -> In reg); - (fun reg -> Let reg); - (fun reg -> Match reg); - (fun reg -> Mod reg); - (fun reg -> Not reg); - (fun reg -> Of reg); - (fun reg -> Or reg); - (fun reg -> Then reg); - (fun reg -> True reg); - (fun reg -> Type reg); - (fun reg -> With reg)] + (fun reg -> Begin reg); + (fun reg -> Else reg); + (fun reg -> End reg); + (fun reg -> False reg); + (fun reg -> Fun reg); + (fun reg -> Rec reg); + (fun reg -> If reg); + (fun reg -> In reg); + (fun reg -> Let reg); + (fun reg -> Match reg); + (fun reg -> Mod reg); + (fun reg -> Not reg); + (fun reg -> Of reg); + (fun reg -> Or reg); + (fun reg -> Then reg); + (fun reg -> True reg); + (fun reg -> Type reg); + (fun reg -> With reg)] let reserved = let open SSet in @@ -508,6 +512,9 @@ let mk_attr header lexeme region = if header = "[@" then Error Invalid_attribute else Ok (Attr Region.{value=lexeme; region}) +let mk_insert lexeme region = + Insert Region.{value=lexeme;region} + (* Predicates *) let is_string = function String _ -> true | _ -> false diff --git a/src/passes/01-parser/cameligo/ParToken.mly b/src/passes/01-parser/cameligo/ParToken.mly index 0214d56a3..0ac44271b 100644 --- a/src/passes/01-parser/cameligo/ParToken.mly +++ b/src/passes/01-parser/cameligo/ParToken.mly @@ -14,6 +14,7 @@ %token Ident "" %token Constr "" %token Attr "" +%token Insert "" (* Symbols *) diff --git a/src/passes/01-parser/cameligo/Parser.mly b/src/passes/01-parser/cameligo/Parser.mly index cf4c0494b..d645ac39f 100644 --- a/src/passes/01-parser/cameligo/Parser.mly +++ b/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: + Insert "" ":" type_expr "]" { + let region = cover $1.region $5 in + let value = { + language =$1; + code =$2; + colon =$3; + type_anno=$4; + rbracket =$5} + in {region; value} } diff --git a/src/passes/01-parser/cameligo/ParserLog.ml b/src/passes/01-parser/cameligo/ParserLog.ml index 49d9b2562..7ba9cf096 100644 --- a/src/passes/01-parser/cameligo/ParserLog.ml +++ b/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 {language;code;colon;type_anno;rbracket} : code_insert = value in + print_string state language; + print_string state code; + print_token state colon ":"; + print_type_expr state type_anno; + 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,21 @@ 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 ""; + pp_string (state#pad 1 0) rc.language in + let () = + let state = state#pad 3 1 in + pp_node state ""; + pp_string (state#pad 1 0) rc.code in + let () = + let state = state#pad 3 2 in + pp_node state ""; + 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 let {binders; lhs_type; let_rhs; _} = binding in diff --git a/src/passes/01-parser/cameligo/Unlexer.ml b/src/passes/01-parser/cameligo/Unlexer.ml index 1d4ac5fef..523d7efee 100644 --- a/src/passes/01-parser/cameligo/Unlexer.ml +++ b/src/passes/01-parser/cameligo/Unlexer.ml @@ -43,6 +43,7 @@ let concrete = function | "PLUS" -> "+" | "SLASH" -> "/" | "TIMES" -> "*" +| "PERCENT" -> "%" | "LPAR" -> "(" | "RPAR" -> ")" diff --git a/src/passes/01-parser/pascaligo/AST.ml b/src/passes/01-parser/pascaligo/AST.ml index ad5e8be7e..4adfb7b45 100644 --- a/src/passes/01-parser/pascaligo/AST.ml +++ b/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 = { + language : string reg; + code : string reg; + colon : colon; + type_anno : type_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 diff --git a/src/passes/01-parser/pascaligo/LexToken.mli b/src/passes/01-parser/pascaligo/LexToken.mli index a217a6370..1adc7db2d 100644 --- a/src/passes/01-parser/pascaligo/LexToken.mli +++ b/src/passes/01-parser/pascaligo/LexToken.mli @@ -44,6 +44,7 @@ type t = | Mutez of (lexeme * Z.t) Region.reg | Ident of lexeme Region.reg | Constr of lexeme Region.reg +| Insert of lexeme Region.reg (* Symbols *) @@ -161,6 +162,7 @@ val mk_verbatim : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result +val mk_insert : lexeme -> Region.t -> token val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/01-parser/pascaligo/LexToken.mll b/src/passes/01-parser/pascaligo/LexToken.mll index 4f28b9e71..56401eccc 100644 --- a/src/passes/01-parser/pascaligo/LexToken.mll +++ b/src/passes/01-parser/pascaligo/LexToken.mll @@ -32,6 +32,7 @@ type t = | Mutez of (lexeme * Z.t) Region.reg | Ident of lexeme Region.reg | Constr of lexeme Region.reg +| Insert of lexeme Region.reg (* Symbols *) @@ -141,6 +142,14 @@ let proj_token = function | Constr Region.{region; value} -> region, sprintf "Constr \"%s\"" value +| Insert Region.{region; value} -> + region, sprintf "Insert \"%s\"" value + +(* +| Attr {header; string={region; value}} -> + region, sprintf "Attr (\"%s\",\"%s\")" header value + *) + (* Symbols *) | SEMI region -> region, "SEMI" @@ -233,6 +242,7 @@ let to_lexeme = function | Mutez i -> fst i.Region.value | Ident id | Constr id -> id.Region.value +| Insert i -> i.Region.value (* Symbols *) @@ -365,7 +375,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 @@ -543,6 +553,11 @@ type attr_err = Invalid_attribute let mk_attr _ _ _ = Error Invalid_attribute +(* Raw Code Insertion *) + +let mk_insert lexeme region = + Insert Region.{value=lexeme;region} + (* Predicates *) let is_string = function String _ -> true | _ -> false diff --git a/src/passes/01-parser/pascaligo/ParToken.mly b/src/passes/01-parser/pascaligo/ParToken.mly index 49a90168e..f51dfc30e 100644 --- a/src/passes/01-parser/pascaligo/ParToken.mly +++ b/src/passes/01-parser/pascaligo/ParToken.mly @@ -13,6 +13,7 @@ %token <(LexToken.lexeme * Z.t) Region.reg> Mutez "" %token Ident "" %token Constr "" +%token Insert "" (* Symbols *) diff --git a/src/passes/01-parser/pascaligo/Parser.mly b/src/passes/01-parser/pascaligo/Parser.mly index 8052be9fc..1548ae30b 100644 --- a/src/passes/01-parser/pascaligo/Parser.mly +++ b/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 } | "" 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: + Insert "" ":" type_expr "]" { + let region = cover $1.region $5 in + let value = { + language =$1; + code =$2; + colon =$3; + type_anno=$4; + rbracket =$5} + in {region; value} } + field_assignment: field_name "=" expr { let region = cover $1.region (expr_to_region $3) diff --git a/src/passes/01-parser/pascaligo/ParserLog.ml b/src/passes/01-parser/pascaligo/ParserLog.ml index 3ae039e8e..41f8405d1 100644 --- a/src/passes/01-parser/pascaligo/ParserLog.ml +++ b/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 {language;code;colon;type_anno;rbracket} : code_insert = value in + print_string state language; + print_string state code; + print_token state colon ":"; + print_type_expr state type_anno; + print_token state rbracket "]" + and print_parameters state {value; _} = let {lpar; inside; rpar} = value in print_token state lpar "("; @@ -439,26 +447,27 @@ and print_bind_to state = function | None -> () and print_expr state = function - ECase {value;_} -> print_case_expr state value -| ECond {value;_} -> print_cond_expr state value -| EAnnot {value;_} -> print_annot_expr state value -| ELogic e -> print_logic_expr state e -| EArith e -> print_arith_expr state e -| EString e -> print_string_expr state e -| EList e -> print_list_expr state e -| ESet e -> print_set_expr state e -| EConstr e -> print_constr_expr state e -| ERecord e -> print_record_expr state e -| EUpdate e -> print_update_expr state e -| EProj e -> print_projection state e -| EMap e -> print_map_expr state e -| EVar v -> print_var state v -| ECall e -> print_fun_call state e -| EBytes b -> print_bytes state b -| EUnit r -> print_token state r "Unit" -| ETuple e -> print_tuple_expr state e -| EPar e -> print_par_expr state e -| EFun e -> print_fun_expr state e + ECase {value;_} -> print_case_expr state value +| ECond {value;_} -> print_cond_expr state value +| EAnnot {value;_} -> print_annot_expr state value +| ELogic e -> print_logic_expr state e +| EArith e -> print_arith_expr state e +| EString e -> print_string_expr state e +| EList e -> print_list_expr state e +| ESet e -> print_set_expr state e +| EConstr e -> print_constr_expr state e +| ERecord e -> print_record_expr state e +| EUpdate e -> print_update_expr state e +| EProj e -> print_projection state e +| EMap e -> print_map_expr state e +| EVar v -> print_var state v +| ECall e -> print_fun_call state e +| EBytes b -> print_bytes state b +| EUnit r -> print_token state r "Unit" +| 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,21 @@ 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 ""; + pp_string (state#pad 1 0) rc.language in + let () = + let state = state#pad 3 1 in + pp_node state ""; + pp_string (state#pad 1 0) rc.code in + let () = + let state = state#pad 3 2 in + pp_node state ""; + 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 let arity = List.length params in @@ -1491,6 +1515,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} -> diff --git a/src/passes/01-parser/reasonligo/LexToken.mli b/src/passes/01-parser/reasonligo/LexToken.mli index 43c0bb9a3..c0dd48bb1 100644 --- a/src/passes/01-parser/reasonligo/LexToken.mli +++ b/src/passes/01-parser/reasonligo/LexToken.mli @@ -90,6 +90,7 @@ type t = | Verbatim of string Region.reg | Bytes of (string * Hex.t) Region.reg | Attr of string Region.reg +| Insert of string Region.reg (* Keywords *) @@ -153,6 +154,7 @@ val mk_string : lexeme -> Region.t -> token val mk_verbatim : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token +val mk_insert : lexeme -> Region.t -> token val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/01-parser/reasonligo/LexToken.mll b/src/passes/01-parser/reasonligo/LexToken.mll index 9021e93c4..212d274b2 100644 --- a/src/passes/01-parser/reasonligo/LexToken.mll +++ b/src/passes/01-parser/reasonligo/LexToken.mll @@ -76,6 +76,7 @@ type t = | Verbatim of string Region.reg | Bytes of (string * Hex.t) Region.reg | Attr of string Region.reg +| Insert of string Region.reg (* Keywords *) @@ -169,6 +170,7 @@ let proj_token = function | C_None region -> region, "C_None" | C_Some region -> region, "C_Some" | Attr Region.{region; value} -> region, sprintf "Attr %s" value +| Insert Region.{region; value} -> region, sprintf "Insert %s" value | EOF region -> region, "EOF" let to_lexeme = function @@ -183,6 +185,7 @@ let to_lexeme = function | Ident id -> id.Region.value | Constr id -> id.Region.value | Attr a -> a.Region.value +| Insert i -> i.Region.value (* Symbols *) @@ -484,6 +487,11 @@ let mk_attr header lexeme region = Ok (Attr Region.{value=lexeme; region}) else Error Invalid_attribute +(* Raw Code Insertion *) + +let mk_insert lexeme region = + Insert Region.{value=lexeme;region} + (* Predicates *) let is_string = function String _ -> true | _ -> false diff --git a/src/passes/01-parser/reasonligo/ParToken.mly b/src/passes/01-parser/reasonligo/ParToken.mly index 4d7dcc913..f4b146009 100644 --- a/src/passes/01-parser/reasonligo/ParToken.mly +++ b/src/passes/01-parser/reasonligo/ParToken.mly @@ -14,6 +14,7 @@ %token Ident "" %token Constr "" %token Attr "" +%token Insert "" (* Symbols *) diff --git a/src/passes/01-parser/reasonligo/Parser.mly b/src/passes/01-parser/reasonligo/Parser.mly index 6f85f729a..208e251dc 100644 --- a/src/passes/01-parser/reasonligo/Parser.mly +++ b/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: + Insert "" ":" type_expr "]" { + let region = cover $1.region $5 in + let value = { + language =$1; + code =$2; + colon =$3; + type_anno=$4; + rbracket =$5} + in {region; value} } + expr_with_let_expr: expr | let_expr(expr_with_let_expr) { $1 } diff --git a/src/passes/01-parser/shared/Lexer.mli b/src/passes/01-parser/shared/Lexer.mli index fd94773ed..f8094f1ca 100644 --- a/src/passes/01-parser/shared/Lexer.mli +++ b/src/passes/01-parser/shared/Lexer.mli @@ -79,6 +79,7 @@ module type TOKEN = val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result + val mk_insert : lexeme -> Region.t -> token val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/01-parser/shared/Lexer.mll b/src/passes/01-parser/shared/Lexer.mll index 05d2ee1f1..f5e0ae5f9 100644 --- a/src/passes/01-parser/shared/Lexer.mll +++ b/src/passes/01-parser/shared/Lexer.mll @@ -43,6 +43,7 @@ module type TOKEN = val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result + val mk_insert : lexeme -> Region.t -> token val eof : Region.t -> token (* Predicates *) @@ -268,6 +269,11 @@ module Make (Token : TOKEN) : (S with module Token = Token) = | Error Token.Invalid_attribute -> fail region Invalid_attribute + let mk_insert insert state buffer = + let region, _, state = state#sync buffer in + let token = Token.mk_insert insert region + in state#enqueue token + let mk_constr state buffer = let region, lexeme, state = state#sync buffer in let token = Token.mk_constr lexeme region @@ -314,7 +320,7 @@ let esc = "\\n" | "\\\"" | "\\\\" | "\\b" let common_sym = ';' | ',' | '(' | ')' | '[' | ']' | '{' | '}' | '=' | ':' | '|' | "->" | '.' | '_' | '^' - | '+' | '-' | '*' | '/' | '<' | "<=" | '>' | ">=" + | '+' | '-' | '*' | '/' | '%' | '<' | "<=" | '>' | ">=" let pascaligo_sym = "=/=" | '#' | ":=" let cameligo_sym = "<>" | "::" | "||" | "&&" let reasonligo_sym = '!' | "=>" | "!=" | "==" | "++" | "..." | "||" | "&&" @@ -353,6 +359,7 @@ let line_comments = (* #include files *) let string = [^'"' '\\' '\n']* (* For strings of #include *) +let insert = attr (* RULES *) @@ -388,6 +395,7 @@ and scan state = parse | eof { mk_eof state lexbuf } | "[@" (attr as a) "]" { mk_attr "[@" a state lexbuf } | "[@@" (attr as a) "]" { mk_attr "[@@" a state lexbuf } +| "[%" (insert as i) "]" { mk_insert i state lexbuf } (* Management of #include preprocessing directives diff --git a/src/passes/02-concrete_to_imperative/cameligo.ml b/src/passes/02-concrete_to_imperative/cameligo.ml index 73fae2fda..3a6d44145 100644 --- a/src/passes/02-concrete_to_imperative/cameligo.ml +++ b/src/passes/02-concrete_to_imperative/cameligo.ml @@ -638,6 +638,13 @@ 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 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 + ) and compile_fun lamb' : expr result = let return x = ok x in diff --git a/src/passes/02-concrete_to_imperative/pascaligo.ml b/src/passes/02-concrete_to_imperative/pascaligo.ml index 942b5fd04..a7a459135 100644 --- a/src/passes/02-concrete_to_imperative/pascaligo.ml +++ b/src/passes/02-concrete_to_imperative/pascaligo.ml @@ -459,6 +459,13 @@ 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 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 + and compile_update (u: Raw.update Region.reg) = let u, loc = r_split u in let name, path = compile_path u.record in diff --git a/src/passes/04-imperative_to_sugar/imperative_to_sugar.ml b/src/passes/04-imperative_to_sugar/imperative_to_sugar.ml index 107f41000..5e2aa0a4d 100644 --- a/src/passes/04-imperative_to_sugar/imperative_to_sugar.ml +++ b/src/passes/04-imperative_to_sugar/imperative_to_sugar.ml @@ -220,7 +220,7 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression) 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 {language;code;type_anno} + return @@ O.e_raw_code ~loc language code type_anno | I.E_constructor {constructor;element} -> let%bind element = compile_expression element in return @@ O.e_constructor ~loc constructor element diff --git a/src/passes/06-sugar_to_core/sugar_to_core.ml b/src/passes/06-sugar_to_core/sugar_to_core.ml index 5c3f2da9a..17049b9d7 100644 --- a/src/passes/06-sugar_to_core/sugar_to_core.ml +++ b/src/passes/06-sugar_to_core/sugar_to_core.ml @@ -72,7 +72,7 @@ let rec compile_expression : I.expression -> O.expression result = 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 = idle_type_expression type_anno in + let%bind type_anno = compile_type_expression type_anno in return @@ O.E_raw_code {language;code;type_anno} | I.E_constructor {constructor;element} -> let%bind element = compile_expression element in diff --git a/src/passes/07-self_ast_core/helpers.ml b/src/passes/07-self_ast_core/helpers.ml index 572da1832..cfbb6a3ca 100644 --- a/src/passes/07-self_ast_core/helpers.ml +++ b/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 diff --git a/src/passes/08-typer-new/wrap.ml b/src/passes/08-typer-new/wrap.ml index 11db3f263..040b25ee9 100644 --- a/src/passes/08-typer-new/wrap.ml +++ b/src/passes/08-typer-new/wrap.ml @@ -309,11 +309,11 @@ let recursive : T.type_expression -> (constraints * T.type_variable) = 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 - O.[ - C_equation (type_anno, P_variable whole_expr) - ], whole_expr + let type_anno = type_expression_to_type_value type_anno in + let whole_expr = Core.fresh_type_variable () in + [ + c_equation type_anno (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 -> diff --git a/src/stages/1-ast_imperative/combinators.ml b/src/stages/1-ast_imperative/combinators.ml index 76a9f110c..1431b73c2 100644 --- a/src/stages/1-ast_imperative/combinators.ml +++ b/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 type_anno = make_e ?loc @@ E_raw_code {language; code; type_anno} 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} diff --git a/src/stages/1-ast_imperative/combinators.mli b/src/stages/1-ast_imperative/combinators.mli index 61b947e60..1aabf637f 100644 --- a/src/stages/1-ast_imperative/combinators.mli +++ 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 -> string -> type_expression -> expression val e_constructor : ?loc:Location.t -> string -> expression -> expression val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression diff --git a/src/stages/2-ast_sugar/combinators.ml b/src/stages/2-ast_sugar/combinators.ml index 2243c08ab..71296491a 100644 --- a/src/stages/2-ast_sugar/combinators.ml +++ b/src/stages/2-ast_sugar/combinators.ml @@ -104,6 +104,7 @@ let e_lambda ?loc binder input_type output_type result : expression = make_e ?lo 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 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} diff --git a/src/stages/2-ast_sugar/combinators.mli b/src/stages/2-ast_sugar/combinators.mli index 206cd0c8d..a41f594fb 100644 --- a/src/stages/2-ast_sugar/combinators.mli +++ b/src/stages/2-ast_sugar/combinators.mli @@ -70,6 +70,7 @@ 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 diff --git a/src/stages/4-ast_typed/compute_environment.ml b/src/stages/4-ast_typed/compute_environment.ml index cde26d1d1..199696f7d 100644 --- a/src/stages/4-ast_typed/compute_environment.ml +++ b/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 } diff --git a/src/test/contracts/michelson_insertion.ligo b/src/test/contracts/michelson_insertion.ligo new file mode 100644 index 000000000..19ca60630 --- /dev/null +++ b/src/test/contracts/michelson_insertion.ligo @@ -0,0 +1,4 @@ +// Test michelson insertion in PascaLIGO + +function michelson_add (var n : nat) : nat is + [%Michelson {| DUP;ADD |} : nat -> nat ] diff --git a/src/test/contracts/michelson_insertion.mligo b/src/test/contracts/michelson_insertion.mligo new file mode 100644 index 000000000..4ab073888 --- /dev/null +++ b/src/test/contracts/michelson_insertion.mligo @@ -0,0 +1,4 @@ +// Test michelson insertion in CameLIGO + +let michelson_add (n : nat) : nat = + [%Michelson {| DUP;ADD; PUSH "hello" |} : nat -> nat ] diff --git a/src/test/contracts/michelson_insertion.religo b/src/test/contracts/michelson_insertion.religo new file mode 100644 index 000000000..b397e1934 --- /dev/null +++ b/src/test/contracts/michelson_insertion.religo @@ -0,0 +1,4 @@ +// Test michelson insertion in ReasonLIGO + +let michelson_add = (n : nat) : nat => + [%Michelson {| DUP;ADD; PUSH "hello" |} : nat => nat ]