diff --git a/src/passes/1-parser/cameligo/AST.ml b/src/passes/1-parser/cameligo/AST.ml index 25104af3e..b8ac37bd2 100644 --- a/src/passes/1-parser/cameligo/AST.ml +++ b/src/passes/1-parser/cameligo/AST.ml @@ -312,6 +312,7 @@ and comp_expr = | Neq of neq bin_op reg and record = field_assign reg ne_injection + and projection = { struct_name : variable; selector : dot; @@ -335,6 +336,7 @@ and update = { updates : record reg; rbrace : rbrace; } + and path = Name of variable | Path of projection reg @@ -376,7 +378,7 @@ and cond_expr = { ifso : expr; kwd_else : kwd_else; ifnot : expr - } +} (* Projecting regions from some nodes of the AST *) diff --git a/src/passes/1-parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml index 64c169f06..343f9195d 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -1,129 +1,148 @@ open Trace -module Parser = Parser_pascaligo.Parser -module AST = Parser_pascaligo.AST +(*module Parser = Parser_pascaligo.Parser*) (*module ParserLog = Parser_pascaligo.ParserLog*) +module AST = Parser_pascaligo.AST +module ParErr = Parser_pascaligo.ParErr module LexToken = Parser_pascaligo.LexToken module Lexer = Lexer.Make(LexToken) module Scoping = Parser_pascaligo.Scoping +module SSet = Utils.String.Set -module Errors = struct +(* Mock options. TODO: Plug in cmdliner. *) - let lexer_error (e: Lexer.error AST.reg) = - let title () = "lexer error" in - let message () = Lexer.error_to_string e.value in - let data = [ - ("parser_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region - ) - ] in - error ~data title message +let pre_options = + EvalOpt.make + ~libs:[] + ~verbose:SSet.empty + ~offsets:true + ~mode:`Point + ~cmd:EvalOpt.Quiet + ~mono:true (* Monolithic API of Menhir for now *) +(* ~input:None *) +(* ~expr:true *) - let reserved_name Region.{value; region} = - let title () = Printf.sprintf "reserved name \"%s\"" value in - let message () = "" in - let data = [ +module Parser = + struct + type ast = AST.t + type expr = AST.expr + include Parser_pascaligo.Parser + end + +module ParserLog = + struct + type ast = AST.t + type expr = AST.expr + include Parser_pascaligo.ParserLog + end + +module PreUnit = ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog) +module Front = ParserAPI.Make (Lexer)(Parser)(ParErr) + +let issue_error point = + let error = Front.format_error ~offsets:true (* TODO: CLI *) + `Point (* TODO: CLI *) point + in Stdlib.Error error + +module Errors = + struct + let reserved_name Region.{value; region} = + let title () = Printf.sprintf "reserved name \"%s\"" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message + + let non_linear_pattern Region.{value; region} = + let title () = + Printf.sprintf "repeated variable \"%s\" in this pattern" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message + + let duplicate_parameter Region.{value; region} = + let title () = + Printf.sprintf "duplicate parameter \"%s\"" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message + + let duplicate_variant Region.{value; region} = + let title () = + Printf.sprintf "duplicate variant \"%s\" in this\ + type declaration" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message + + let unrecognized_error source (start: Lexing.position) + (stop: Lexing.position) lexbuf = + let title () = "unrecognized error" in + let file = + if source = "" then "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source in + let message () = + Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) + file in + let loc = Region.make ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte stop) in + let data = [ + ("unrecognized_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] + in error ~data title message + + let detached_attributes (attrs: AST.attributes) = + let title () = "detached attributes" in + let message () = "" in + let data = [ ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message + fun () -> Format.asprintf "%a" Location.pp_lift @@ attrs.region)] + in error ~data title message - let non_linear_pattern Region.{value; region} = - let title () = Printf.sprintf "repeated variable \"%s\" in this pattern" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message - - let duplicate_parameter Region.{value; region} = - let title () = Printf.sprintf "duplicate parameter \"%s\"" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message - - let duplicate_variant Region.{value; region} = - let title () = Printf.sprintf "duplicate variant \"%s\" in this\ - type declaration" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message - - let detached_attributes (attrs: AST.attributes) = - let title () = "detached attributes" in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ attrs.region) - ] in - error ~data title message - - let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = - let title () = "parser error" in - let file = if source = "" then - "" - else - Format.sprintf "In file \"%s|%s\"" start.pos_fname source - in - let str = Format.sprintf - "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" - (Lexing.lexeme lexbuf) - start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) - file - in - let message () = str in - let loc = if start.pos_cnum = -1 then - Region.make - ~start: Pos.min - ~stop:(Pos.from_byte end_) - else - Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) - in - let data = - [ - ("parser_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) - ] - in - error ~data title message - - let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = - let title () = "unrecognized error" in - let file = if source = "" then - "" - else - Format.sprintf "In file \"%s|%s\"" start.pos_fname source - in - let str = Format.sprintf - "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" - (Lexing.lexeme lexbuf) - start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) - file - in - let message () = str in - let loc = Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) - in - let data = [ - ("unrecognized_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) - ] in - error ~data title message + let parser_error source (start: Lexing.position) + (stop: Lexing.position) lexbuf = + let title () = "parser error" in + let file = + if source = "" then "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source in + let message () = + Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) + file in + let loc = + if start.pos_cnum = -1 then + Region.make ~start: Pos.min ~stop:(Pos.from_byte stop) + else + Region.make ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte stop) in + let data = + [("parser_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] in + error ~data title message + let lexer_error (e: Lexer.error AST.reg) = + let title () = "lexer error" in + let message () = Lexer.error_to_string e.value in + let data = [ + ("parser_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region)] + in error ~data title message end open Errors @@ -131,35 +150,37 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a let parse (parser: 'a parser) source lexbuf = - let Lexer.{read ; close ; _} = Lexer.open_token_stream None in + let Lexer.{read; close; _} = Lexer.open_token_stream None in let result = - try - ok (parser read lexbuf) - with - Scoping.Error (Scoping.Non_linear_pattern var) -> - fail @@ (non_linear_pattern var) + try ok (parser read lexbuf) with + Lexer.Error e -> + fail @@ lexer_error e + | Parser.Error -> + let start = Lexing.lexeme_start_p lexbuf in + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ parser_error source start stop lexbuf + | Scoping.Error (Scoping.Non_linear_pattern var) -> + fail @@ non_linear_pattern var | Scoping.Error (Duplicate_parameter name) -> - fail @@ (duplicate_parameter name) + fail @@ duplicate_parameter name | Scoping.Error (Duplicate_variant name) -> - fail @@ (duplicate_variant name) + fail @@ duplicate_variant name | Scoping.Error (Reserved_name name) -> - fail @@ (reserved_name name) - | SyntaxError.Error (Detached_attributes attrs) -> - fail @@ (detached_attributes attrs) + fail @@ reserved_name name + | Scoping.Error (Detached_attributes attrs) -> + fail @@ detached_attributes attrs | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in let end_ = Lexing.lexeme_end_p lexbuf in fail @@ (parser_error source start end_ lexbuf) | Lexer.Error e -> - fail @@ (lexer_error e) + fail @@ lexer_error e | _ -> - let _ = Printexc.print_backtrace Pervasives.stdout in + let () = Printexc.print_backtrace Pervasives.stdout in let start = Lexing.lexeme_start_p lexbuf in - let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (unrecognized_error source start end_ lexbuf) - in - close (); - result + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ unrecognized_error source start stop lexbuf + in close (); result let parse_file (source: string) : AST.t result = let pp_input = @@ -177,6 +198,17 @@ let parse_file (source: string) : AST.t result = let lexbuf = Lexing.from_channel channel in parse (Parser.contract) source lexbuf +let parse_file' (source: string) : AST.t result = + let module IO = + struct + let ext = "ligo" + let options = pre_options ~input:(Some source) ~expr:false + end in + let module Unit = PreUnit(IO) in + match Unit.parse Unit.parse_contract with + Ok ast -> ok ast + | Error error -> failwith "TODO" (* fail @@ parser_or_lexer_error error *) + let parse_string (s:string) : AST.t result = let lexbuf = Lexing.from_string s in parse (Parser.contract) "" lexbuf diff --git a/src/passes/1-parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links index 8d77d2246..6cc2d4c32 100644 --- a/src/passes/1-parser/pascaligo/.links +++ b/src/passes/1-parser/pascaligo/.links @@ -20,4 +20,6 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/LexerUnit.ml ../shared/ParserUnit.mli ../shared/ParserUnit.ml +../shared/Memo.mli +../shared/Memo.ml Stubs/Simple_utils.ml diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index a855ea46e..ff00926d7 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -25,6 +25,7 @@ type 'a reg = 'a Region.reg type keyword = Region.t type kwd_and = Region.t +type kwd_attributes = Region.t type kwd_begin = Region.t type kwd_block = Region.t type kwd_case = Region.t @@ -109,7 +110,7 @@ type field_name = string reg type map_name = string reg type set_name = string reg type constr = string reg -type attribute = string reg +type attribute = string reg (* Parentheses *) @@ -144,12 +145,12 @@ type t = { and ast = t -and attributes = attribute list reg +and attributes = attribute ne_injection reg and declaration = - TypeDecl of type_decl reg + TypeDecl of type_decl reg | ConstDecl of const_decl reg -| FunDecl of fun_decl reg +| FunDecl of fun_decl reg and const_decl = { kwd_const : kwd_const; @@ -159,7 +160,7 @@ and const_decl = { equal : equal; init : expr; terminator : semi option; - attributes : attributes; + attributes : attributes option } (* Type declarations *) @@ -217,7 +218,7 @@ and fun_decl = { block_with : (block reg * kwd_with) option; return : expr; terminator : semi option; - attributes : attributes; + attributes : attributes option; } and parameters = (param_decl, semi) nsepseq par reg @@ -562,6 +563,7 @@ and field_assign = { equal : equal; field_expr : expr } + and record = field_assign reg ne_injection and projection = { diff --git a/src/passes/1-parser/pascaligo/LexToken.mli b/src/passes/1-parser/pascaligo/LexToken.mli index 598b6de4f..f2ce709ae 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mli +++ b/src/passes/1-parser/pascaligo/LexToken.mli @@ -28,6 +28,11 @@ type lexeme = string (* TOKENS *) +type attribute = { + header : string; + string : lexeme Region.reg +} + type t = (* Literals *) @@ -38,6 +43,7 @@ type t = | Mutez of (lexeme * Z.t) Region.reg | Ident of lexeme Region.reg | Constr of lexeme Region.reg +| Attr of attribute (* Symbols *) @@ -151,8 +157,7 @@ val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result val mk_string : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token -val mk_attr : lexeme -> Region.t -> (token, attr_err) result -val mk_attr2 : lexeme -> Region.t -> (token, attr_err) result +val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/1-parser/pascaligo/LexToken.mll b/src/passes/1-parser/pascaligo/LexToken.mll index 5a1e47c76..5a7020105 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mll +++ b/src/passes/1-parser/pascaligo/LexToken.mll @@ -26,6 +26,11 @@ let rollback buffer = (* TOKENS *) +type attribute = { + header : string; + string : lexeme Region.reg +} + type t = (* Literals *) @@ -33,9 +38,10 @@ type t = | Bytes of (lexeme * Hex.t) Region.reg | Int of (lexeme * Z.t) Region.reg | Nat of (lexeme * Z.t) Region.reg -| Mutez of (lexeme * Z.t) Region.reg +| Mutez of (lexeme * Z.t) Region.reg | Ident of lexeme Region.reg | Constr of lexeme Region.reg +| Attr of attribute (* Symbols *) @@ -144,6 +150,9 @@ 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" @@ -217,7 +226,7 @@ let proj_token = function | C_None region -> region, "C_None" | C_Some region -> region, "C_Some" - + (* Virtual tokens *) | EOF region -> region, "EOF" @@ -233,6 +242,7 @@ let to_lexeme = function | Mutez i -> fst i.Region.value | Ident id | Constr id -> id.Region.value +| Attr {string; _} -> string.Region.value (* Symbols *) @@ -312,6 +322,7 @@ let to_lexeme = function | EOF _ -> "" +(* CONVERSIONS *) let to_string token ?(offsets=true) mode = let region, val_str = proj_token token in @@ -365,7 +376,7 @@ let keywords = [ let reserved = let open SSet in - empty |> add "args" + empty |> add "arguments" let constructors = [ (fun reg -> False reg); @@ -489,8 +500,6 @@ let eof region = EOF region type sym_err = Invalid_symbol -type attr_err = Invalid_attribute - let mk_sym lexeme region = match lexeme with (* Lexemes in common with all concrete syntaxes *) @@ -539,10 +548,9 @@ let mk_constr lexeme region = (* Attributes *) -let mk_attr _lexeme _region = - Error Invalid_attribute +type attr_err = Invalid_attribute -let mk_attr2 _lexeme _region = +let mk_attr _header _string _region = Error Invalid_attribute (* Predicates *) diff --git a/src/passes/1-parser/pascaligo/LexerMain.ml b/src/passes/1-parser/pascaligo/LexerMain.ml index 4f1940204..042b0930a 100644 --- a/src/passes/1-parser/pascaligo/LexerMain.ml +++ b/src/passes/1-parser/pascaligo/LexerMain.ml @@ -7,3 +7,8 @@ module IO = end module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) + +let () = + match M.trace () with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg diff --git a/src/passes/1-parser/pascaligo/ParToken.mly b/src/passes/1-parser/pascaligo/ParToken.mly index 11275b76e..61397c7e3 100644 --- a/src/passes/1-parser/pascaligo/ParToken.mly +++ b/src/passes/1-parser/pascaligo/ParToken.mly @@ -12,6 +12,7 @@ %token <(LexToken.lexeme * Z.t) Region.reg> Mutez "" %token Ident "" %token Constr "" +%token Attr "" (* Symbols *) diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 7325cd1df..21e1947bf 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -5,39 +5,40 @@ open Region open AST - -type statement_attributes_mixed = +(* +type statement_attributes_mixed = PInstr of instruction | PData of data_decl -| PAttributes of attributes +| PAttr of attributes let attributes_to_statement (statement, statements) = - if (List.length statements = 0) then - match statement with - | PInstr i -> Instr i, [] - | PData d -> Data d, [] - | PAttributes a -> - let open! SyntaxError in - raise (Error (Detached_attributes a)) - else ( + match statements with + [] -> + (match statement with + | PInstr i -> Instr i, [] + | PData d -> Data d, [] + | PAttr a -> + raise (Scoping.Error (Scoping.Detached_attributes a))) + | _ -> ( let statements = (Region.ghost, statement) :: statements in let rec inner result = function - | (t, PData (LocalConst const)) :: (_, PAttributes a) :: rest -> + | (t, PData (LocalConst const)) :: (_, PAttr a) :: rest -> inner (result @ [(t, Data (LocalConst {const with value = {const.value with attributes = a}}))]) rest - | (t, PData (LocalFun func)) :: (_, PAttributes a) :: rest -> - inner (result @ [(t, Data (LocalFun {func with value = {func.value with attributes = a}}))]) rest + | (t, PData (LocalFun func)) :: (_, PAttr a) :: rest -> + inner (result @ [(t, Data (LocalFun {func with value = {func.value with attributes = a}}))]) rest | (t, PData d) :: rest -> inner (result @ [(t, Data d)]) rest | (t, PInstr i) :: rest -> inner (result @ [(t, Instr i)]) rest - | (_, PAttributes _) :: rest -> + | (_, PAttr _) :: rest -> inner result rest - | [] -> + | [] -> result - in + in let result = inner [] statements in (snd (List.hd result), List.tl result) ) + *) (* END HEADER *) %} @@ -145,7 +146,7 @@ contract: declaration: type_decl { TypeDecl $1 } | const_decl { ConstDecl $1 } -| fun_decl { FunDecl $1 } +| fun_decl { FunDecl $1 } (* Type declarations *) @@ -258,7 +259,7 @@ field_decl: and value = {field_name=$1; colon=$2; field_type=$3} in {region; value} } - + fun_expr: "function" parameters ":" type_expr "is" expr { let stop = expr_to_region $6 in @@ -290,7 +291,7 @@ open_fun_decl: block_with = Some ($7, $8); return = $9; terminator = None; - attributes = {value = []; region = Region.ghost}} + attributes = None} in {region; value} } | "function" fun_name parameters ":" type_expr "is" expr { Scoping.check_reserved_name $2; @@ -305,14 +306,16 @@ open_fun_decl: block_with = None; return = $7; terminator = None; - attributes = {value = []; region = Region.ghost}} + attributes = None} in {region; value} } fun_decl: - open_fun_decl semi_attributes { - let attributes, terminator = $2 in - {$1 with value = {$1.value with terminator = terminator; attributes = attributes}} - } + open_fun_decl maybe_attributes? { + match $2 with + None -> $1 + | Some (terminator, attributes) -> + let value = {$1.value with terminator; attributes} + in {$1 with value} } parameters: par(nsepseq(param_decl,";")) { @@ -350,7 +353,7 @@ block: let statements, terminator = $2 in let region = cover $1 $3 and value = {opening = Begin $1; - statements = attributes_to_statement statements; + statements (*= attributes_to_statement statements*); terminator; closing = End $3} in {region; value} @@ -359,15 +362,15 @@ block: let statements, terminator = $3 in let region = cover $1 $4 and value = {opening = Block ($1,$2); - statements = attributes_to_statement statements; + statements (*= attributes_to_statement statements*); terminator; closing = Block $4} in {region; value} } statement: - instruction { PInstr $1 } -| open_data_decl { PData $1 } -| attributes { PAttributes $1 } + instruction { (*P*)Instr $1 } +| open_data_decl { (*P*)Data $1 } + (*| attributes { PAttr $1 }*) open_data_decl: open_const_decl { LocalConst $1 } @@ -385,10 +388,9 @@ open_const_decl: equal; init; terminator = None; - attributes = {value = []; region = Region.ghost}} + attributes = None} in {region; value} } - open_var_decl: "var" unqualified_decl(":=") { let name, colon, var_type, assign, init, stop = $2 in @@ -399,8 +401,7 @@ open_var_decl: var_type; assign; init; - terminator = None; - } + terminator=None} in {region; value} } unqualified_decl(OP): @@ -409,23 +410,20 @@ unqualified_decl(OP): let region = expr_to_region $5 in $1, $2, $3, $4, $5, region } -attributes: - "attributes" "[" nsepseq(String,";") "]" { - let region = cover $1 $4 in - let value = (Utils.nsepseq_to_list $3) in - {region; value} - } +attributes: + ne_injection("attributes","") { $1 } -semi_attributes: - /* empty */ { {value = []; region = Region.ghost}, None } - | ";" { {value = []; region = Region.ghost}, Some $1 } - | ";" attributes ";" { $2, Some $1 } +maybe_attributes: + ";" { Some $1, None } +| ";" attributes ";" { Some $1, Some $2 } const_decl: - open_const_decl semi_attributes { - let attributes, terminator = $2 in - {$1 with value = {$1.value with terminator = terminator; attributes = attributes }} - } + open_const_decl maybe_attributes? { + match $2 with + None -> $1 + | Some (terminator, attributes) -> + let value = {$1.value with terminator; attributes} + in {$1 with value} } instruction: conditional { Cond $1 } @@ -589,7 +587,7 @@ clause_block: let statements, terminator = $2 in let region = cover $1 $3 in let value = {lbrace = $1; - inside = attributes_to_statement statements, terminator; + inside = (*attributes_to_statement*) statements, terminator; rbrace = $3} in ShortBlock {value; region} } diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index 4a186980e..bacb39a4f 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -114,12 +114,10 @@ let rec print_tokens state ast = Utils.nseq_iter (print_decl state) decl; print_token state eof "EOF" -and print_attributes state attributes = - let attributes = List.fold_left (fun all a -> all ^ a.value ^ ";") "" attributes.value in - let line = - sprintf "attributes[%s]" - attributes - in Buffer.add_string state#buffer line +and print_attributes state = function + None -> () +| Some attr -> + print_ne_injection state "attributes" print_string attr and print_decl state = function TypeDecl decl -> print_type_decl state decl @@ -607,7 +605,7 @@ and print_field_assign state {value; _} = print_token state equal "="; print_expr state field_expr -and print_update_expr state {value; _} = +and print_update_expr state {value; _} = let {record; kwd_with; updates} = value in print_path state record; print_token state kwd_with "with"; @@ -850,19 +848,23 @@ and pp_declaration state = function pp_fun_decl state value and pp_fun_decl state decl = + let arity = + match decl.attributes with + None -> 5 + | Some _ -> 6 in let () = - let state = state#pad 5 0 in + let state = state#pad arity 0 in pp_ident state decl.fun_name in let () = - let state = state#pad 5 1 in + let state = state#pad arity 1 in pp_node state ""; pp_parameters state decl.param in let () = - let state = state#pad 5 2 in + let state = state#pad arity 2 in pp_node state ""; pp_type_expr (state#pad 1 0) decl.ret_type in let () = - let state = state#pad 5 3 in + let state = state#pad arity 3 in pp_node state ""; let statements = match decl.block_with with @@ -870,15 +872,35 @@ and pp_fun_decl state decl = | None -> Instr (Skip Region.ghost), [] in pp_statements state statements in let () = - let state = state#pad 5 4 in + let state = state#pad arity 4 in pp_node state ""; - pp_expr (state#pad 1 0) decl.return + pp_expr (state#pad 1 0) decl.return in + let () = + match decl.attributes with + None -> () + | Some attr -> + let state = state#pad arity 5 in + pp_node state ""; + pp_attributes (state#pad 1 0) attr in () +and pp_attributes state {value; _} = + pp_ne_injection pp_string state value + and pp_const_decl state decl = - pp_ident (state#pad 3 0) decl.name; - pp_type_expr (state#pad 3 1) decl.const_type; - pp_expr (state#pad 3 2) decl.init + let arity = + match decl.attributes with + None -> 3 + | Some _ -> 4 in + pp_ident (state#pad arity 0) decl.name; + pp_type_expr (state#pad arity 1) decl.const_type; + pp_expr (state#pad arity 2) decl.init; + match decl.attributes with + None -> () + | Some attr -> + let state = state#pad arity 3 in + pp_node state ""; + pp_attributes (state#pad 1 0) attr and pp_type_expr state = function TProd cartesian -> diff --git a/src/passes/1-parser/pascaligo/Scoping.mli b/src/passes/1-parser/pascaligo/Scoping.mli index 71f8c1244..b62ef7dd2 100644 --- a/src/passes/1-parser/pascaligo/Scoping.mli +++ b/src/passes/1-parser/pascaligo/Scoping.mli @@ -6,6 +6,7 @@ type t = | Duplicate_variant of AST.variable | Non_linear_pattern of AST.variable | Duplicate_field of AST.variable +| Detached_attributes of AST.attributes type error = t diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 924a51e08..30277f72f 100644 --- a/src/passes/1-parser/shared/EvalOpt.ml +++ b/src/passes/1-parser/shared/EvalOpt.ml @@ -47,9 +47,9 @@ let help language extension () = printf "where %s is the %s source file (default: stdin),\n" extension language; print "and each