From f8d6396fcd6ca13e38c9d810a910eff536fba5ab Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Sun, 15 Dec 2019 17:46:08 +0100 Subject: [PATCH] Refactoring of the parsers * [CameLIGO/ReasonLIGO] The AST node [EAnnot] (expressions annotated by a type) now records the region in the source code for the colon. * [CameLIGO/ReasonLIGO/PascaLIGO] I added the syntax %token <...> TOKEN "lexeme" * [ReasonLIGO] I changed the AST nodes [Mtz] and [Str] to [Mutez] and [String], respectively (in accordance with the PascaLIGO front-end). I changed token [DOTDOTDOT] to [ELLIPSIS]. * [ReasonLIGO] I added what was missing to make a loca build with my Makefile. --- src/passes/1-parser/cameligo/.Parser.ml.tag | 1 - src/passes/1-parser/cameligo/AST.ml | 2 +- src/passes/1-parser/cameligo/AST.mli | 2 +- src/passes/1-parser/cameligo/ParToken.mly | 108 +- src/passes/1-parser/cameligo/Parser.mly | 701 +++++------ src/passes/1-parser/cameligo/ParserLog.ml | 16 +- src/passes/1-parser/pascaligo/LexToken.mli | 2 +- src/passes/1-parser/pascaligo/ParToken.mly | 142 +-- src/passes/1-parser/pascaligo/Parser.mly | 437 ++++--- .../1-parser/pascaligo/Stubs/Simple_utils.ml | 2 + src/passes/1-parser/reasonligo/.LexerMain.tag | 0 .../1-parser/reasonligo/.Parser.mly.tag | 1 + .../1-parser/reasonligo/.ParserMain.tag | 0 src/passes/1-parser/reasonligo/.links | 25 + src/passes/1-parser/reasonligo/LexToken.mli | 24 +- src/passes/1-parser/reasonligo/LexToken.mll | 58 +- src/passes/1-parser/reasonligo/ParToken.mly | 97 +- src/passes/1-parser/reasonligo/Parser.mly | 1086 +++++++---------- .../reasonligo/Stubs/Parser_cameligo.ml | 1 + .../1-parser/reasonligo/Stubs/Simple_utils.ml | 2 + src/passes/2-simplify/cameligo.ml | 11 +- 21 files changed, 1196 insertions(+), 1522 deletions(-) delete mode 100644 src/passes/1-parser/cameligo/.Parser.ml.tag create mode 100644 src/passes/1-parser/pascaligo/Stubs/Simple_utils.ml create mode 100644 src/passes/1-parser/reasonligo/.LexerMain.tag create mode 100644 src/passes/1-parser/reasonligo/.Parser.mly.tag create mode 100644 src/passes/1-parser/reasonligo/.ParserMain.tag create mode 100644 src/passes/1-parser/reasonligo/.links create mode 100644 src/passes/1-parser/reasonligo/Stubs/Parser_cameligo.ml create mode 100644 src/passes/1-parser/reasonligo/Stubs/Simple_utils.ml diff --git a/src/passes/1-parser/cameligo/.Parser.ml.tag b/src/passes/1-parser/cameligo/.Parser.ml.tag deleted file mode 100644 index 8fd5d2b72..000000000 --- a/src/passes/1-parser/cameligo/.Parser.ml.tag +++ /dev/null @@ -1 +0,0 @@ -ocamlc: -w -42-40 diff --git a/src/passes/1-parser/cameligo/AST.ml b/src/passes/1-parser/cameligo/AST.ml index a25d1ef8c..65c07a49d 100644 --- a/src/passes/1-parser/cameligo/AST.ml +++ b/src/passes/1-parser/cameligo/AST.ml @@ -226,7 +226,7 @@ and field_pattern = { and expr = ECase of expr case reg | ECond of cond_expr reg -| EAnnot of (expr * type_expr) reg +| EAnnot of (expr * colon * type_expr) par reg | ELogic of logic_expr | EArith of arith_expr | EString of string_expr diff --git a/src/passes/1-parser/cameligo/AST.mli b/src/passes/1-parser/cameligo/AST.mli index df710299c..c00771ef8 100644 --- a/src/passes/1-parser/cameligo/AST.mli +++ b/src/passes/1-parser/cameligo/AST.mli @@ -214,7 +214,7 @@ and field_pattern = { and expr = ECase of expr case reg (* p1 -> e1 | p2 -> e2 | ... *) | ECond of cond_expr reg (* if e1 then e2 else e3 *) -| EAnnot of (expr * type_expr) reg (* e : t *) +| EAnnot of (expr * colon * type_expr) par reg (* (e : t) *) | ELogic of logic_expr | EArith of arith_expr | EString of string_expr diff --git a/src/passes/1-parser/cameligo/ParToken.mly b/src/passes/1-parser/cameligo/ParToken.mly index b8773e1b3..22610c0aa 100644 --- a/src/passes/1-parser/cameligo/ParToken.mly +++ b/src/passes/1-parser/cameligo/ParToken.mly @@ -5,76 +5,76 @@ (* Literals *) -%token String -%token <(LexToken.lexeme * Hex.t) Region.reg> Bytes -%token <(string * Z.t) Region.reg> Int -%token <(string * Z.t) Region.reg> Nat -%token <(string * Z.t) Region.reg> Mutez -%token Ident -%token Constr +%token String "" +%token <(LexToken.lexeme * Hex.t) Region.reg> Bytes "" +%token <(string * Z.t) Region.reg> Int "" +%token <(string * Z.t) Region.reg> Nat "" +%token <(string * Z.t) Region.reg> Mutez "" +%token Ident "" +%token Constr "" (* Symbols *) -%token MINUS -%token PLUS -%token SLASH -%token TIMES +%token MINUS "-" +%token PLUS "+" +%token SLASH "/" +%token TIMES "*" -%token LPAR -%token RPAR -%token LBRACKET -%token RBRACKET -%token LBRACE -%token RBRACE +%token LPAR "(" +%token RPAR ")" +%token LBRACKET "[" +%token RBRACKET "]" +%token LBRACE "{" +%token RBRACE "}" -%token ARROW -%token CONS -%token CAT -(*%token APPEND*) -%token DOT +%token ARROW "->" +%token CONS "::" +%token CAT "^" +(*%token APPEND "@" *) +%token DOT "." -%token COMMA -%token SEMI -%token COLON -%token VBAR +%token COMMA "," +%token SEMI ";" +%token COLON ":" +%token VBAR "|" -%token WILD +%token WILD "_" -%token EQ -%token NE -%token LT -%token GT -%token LE -%token GE +%token EQ "=" +%token NE "<>" +%token LT "<" +%token GT ">" +%token LE "<=" +%token GE ">=" -%token BOOL_OR -%token BOOL_AND +%token BOOL_OR "||" +%token BOOL_AND "&&" (* Keywords *) (*%token And*) -%token Begin -%token Else -%token End -%token False -%token Fun -%token If -%token In -%token Let -%token Match -%token Mod -%token Not -%token Of -%token Or -%token Then -%token True -%token Type -%token With +%token Begin "begin" +%token Else "else" +%token End "end" +%token False "false" +%token Fun "fun" +%token If "if" +%token In "in" +%token Let "let" +%token Match "match" +%token Mod "mod" +%token Not "not" +%token Of "of" +%token Or "or" +%token Then "then" +%token True "true" +%token Type "type" +%token With "with" (* Data constructors *) -%token C_None (* "None" *) -%token C_Some (* "Some" *) +%token C_None "None" +%token C_Some "Some" (* Virtual tokens *) diff --git a/src/passes/1-parser/cameligo/Parser.mly b/src/passes/1-parser/cameligo/Parser.mly index 61e4b8599..8863da3f1 100644 --- a/src/passes/1-parser/cameligo/Parser.mly +++ b/src/passes/1-parser/cameligo/Parser.mly @@ -41,24 +41,10 @@ sep_or_term_list(item,sep): (* Compound constructs *) par(X): - LPAR X RPAR { + "(" X ")" { let region = cover $1 $3 - and value = { - lpar = $1; - inside = $2; - rpar = $3} - in {region; value} - } - -brackets(X): - LBRACKET X RBRACKET { - let region = cover $1 $3 - and value = { - lbracket = $1; - inside = $2; - rbracket = $3} - in {region; value} - } + and value = {lpar=$1; inside=$2; rpar=$3} + in {region; value} } (* Sequences @@ -69,12 +55,9 @@ brackets(X): latter returns a pair made of the first parsed item (the parameter [X]) and the rest of the sequence (possibly empty). This way, the OCaml typechecker can keep track of this information along the - static control-flow graph. The rule [sepseq] parses possibly empty - sequences of items separated by some token (e.g., a comma), and - rule [nsepseq] is for non-empty such sequences. See module [Utils] - for the types corresponding to the semantic actions of those - rules. -*) + static control-flow graph. See module [Utils] for the types + corresponding to the semantic actions of those rules. + *) (* Possibly empty sequence of items *) @@ -93,51 +76,36 @@ nsepseq(item,sep): item { $1, [] } | item sep nsepseq(item,sep) { let h,t = $3 in $1, ($2,h)::t } -(* Possibly empy separated sequence of items *) - -sepseq(item,sep): - (**) { None } -| nsepseq(item,sep) { Some $1 } - (* Helpers *) -%inline type_name : Ident { $1 } -%inline field_name : Ident { $1 } -%inline module_name : Constr { $1 } -%inline struct_name : Ident { $1 } +%inline type_name : "" { $1 } +%inline field_name : "" { $1 } +%inline struct_name : "" { $1 } +%inline module_name : "" { $1 } (* Non-empty comma-separated values (at least two values) *) tuple(item): - item COMMA nsepseq(item,COMMA) { - let h,t = $3 in $1,($2,h)::t - } + item "," nsepseq(item,",") { let h,t = $3 in $1,($2,h)::t } (* Possibly empty semicolon-separated values between brackets *) list(item): - LBRACKET sep_or_term_list(item,SEMI) RBRACKET { - let elements, terminator = $2 in - let value = { - compound = Brackets ($1,$3); - elements = Some elements; - terminator} in - let region = cover $1 $3 - in {value; region} - } -| LBRACKET RBRACKET { - let value = { - compound = Brackets ($1,$2); - elements = None; - terminator = None} in - let region = cover $1 $2 - in {value; region}} + "[" sep_or_term_list(item,";")? "]" { + let compound = Brackets ($1,$3) + and region = cover $1 $3 in + let elements, terminator = + match $2 with + None -> None, None + | Some (elements, terminator) -> + Some elements, terminator in + let value = {compound; elements; terminator} + in {region; value} } (* Main *) contract: - declarations EOF { - {decl=$1; eof=$2} } + declarations EOF { {decl=$1; eof=$2} } declarations: declaration { $1,[] : AST.declaration Utils.nseq } @@ -150,7 +118,7 @@ declaration: (* Type declarations *) type_decl: - Type type_name EQ type_expr { + "type" type_name "=" type_expr { let region = cover $1 (type_expr_to_region $4) in let value = { kwd_type = $1; @@ -160,253 +128,216 @@ type_decl: in {region; value} } type_expr: - cartesian { $1 } -| sum_type { TSum $1 } -| record_type { TRecord $1 } + cartesian | sum_type | record_type { $1 } cartesian: - fun_type TIMES nsepseq(fun_type,TIMES) { + fun_type { $1 } +| fun_type "*" nsepseq(fun_type,"*") { let value = Utils.nsepseq_cons $1 $2 $3 in let region = nsepseq_to_region type_expr_to_region value - in TProd {region; value} - } -| fun_type { ($1 : type_expr) } + in TProd {region; value} } fun_type: - core_type { - $1 - } -| core_type ARROW fun_type { + core_type { $1 } +| core_type "->" fun_type { let start = type_expr_to_region $1 and stop = type_expr_to_region $3 in let region = cover start stop in TFun {region; value=$1,$2,$3} } core_type: - type_name { - TVar $1 - } -| module_name DOT type_name { + type_name { TVar $1 } +| par(type_expr) { TPar $1 } +| module_name "." type_name { let module_name = $1.value in let type_name = $3.value in let value = module_name ^ "." ^ type_name in let region = cover $1.region $3.region in TVar {region; value} } -| arg=core_type constr=type_constr { - let start = type_expr_to_region arg in - let stop = constr.region in - let region = cover start stop in - let lpar, rpar = ghost, ghost in - let value = {lpar; inside=arg,[]; rpar} in - let arg = {value; region = start} in - TApp Region.{value = (constr,arg); region} +| core_type type_name { + let arg, constr = $1, $2 in + let start = type_expr_to_region arg + and stop = constr.region in + let region = cover start stop in + let lpar, rpar = ghost, ghost in + let value = {lpar; inside=arg,[]; rpar} in + let arg = {region=start; value} + in TApp {region; value = constr,arg} } -| type_tuple type_constr { - let region = cover $1.region $2.region - in TApp {region; value = $2,$1} - } -| par(type_expr) { - TPar $1 } - -type_constr: - type_name { $1 } +| type_tuple type_name { + let arg, constr = $1, $2 in + let region = cover arg.region constr.region + in TApp {region; value = constr,arg} } type_tuple: par(tuple(type_expr)) { $1 } sum_type: - ioption(VBAR) nsepseq(variant,VBAR) { + ioption("|") nsepseq(variant,"|") { let region = nsepseq_to_region (fun x -> x.region) $2 - in {region; value=$2} } + in TSum {region; value=$2} } variant: - Constr Of cartesian { + "" { {$1 with value={constr=$1; arg=None}} } +| "" "of" cartesian { let region = cover $1.region (type_expr_to_region $3) - and value = {constr=$1; arg = Some ($2, $3)} - in {region; value} - } -| Constr { - {region=$1.region; value={constr=$1; arg=None}} } + and value = {constr=$1; arg = Some ($2,$3)} + in {region; value} } record_type: - LBRACE sep_or_term_list(field_decl,SEMI) RBRACE { + "{" sep_or_term_list(field_decl,";") "}" { let ne_elements, terminator = $2 in let region = cover $1 $3 - and value = { - compound = Braces ($1,$3); - ne_elements; - terminator} - in {region; value} } + and value = {compound = Braces ($1,$3); ne_elements; terminator} + in TRecord {region; value} } field_decl: - field_name COLON type_expr { + field_name ":" type_expr { let stop = type_expr_to_region $3 in let region = cover $1.region stop - and value = {field_name = $1; colon = $2; field_type = $3} + and value = {field_name=$1; colon=$2; field_type=$3} in {region; value} } (* Top-level non-recursive definitions *) let_declaration: - Let let_binding { + "let" let_binding { let kwd_let = $1 in let binding = $2 in let value = kwd_let, binding in let stop = expr_to_region binding.let_rhs in let region = cover $1 stop - in {value; region} } + in {region; value} } let_binding: - Ident nseq(sub_irrefutable) type_annotation? EQ expr { + "" nseq(sub_irrefutable) type_annotation? "=" expr { let binders = Utils.nseq_cons (PVar $1) $2 in {binders; lhs_type=$3; eq=$4; let_rhs=$5} } -| irrefutable type_annotation? EQ expr { - let binders = $1,[] in - {binders; lhs_type=$2; eq=$3; let_rhs=$4} } +| irrefutable type_annotation? "=" expr { + {binders=$1,[]; lhs_type=$2; eq=$3; let_rhs=$4} } type_annotation: - COLON type_expr { $1,$2 } + ":" type_expr { $1,$2 } (* Patterns *) irrefutable: - tuple(sub_irrefutable) { + sub_irrefutable { $1 } +| tuple(sub_irrefutable) { let hd, tl = $1 in let start = pattern_to_region hd in let stop = last fst tl in let region = cover start stop - in PTuple {value=$1; region} - } -| sub_irrefutable { $1 } + in PTuple {region; value=$1} } sub_irrefutable: - Ident { PVar $1 } -| WILD { PWild $1 } + "" { PVar $1 } +| "_" { PWild $1 } | unit { PUnit $1 } | record_pattern { PRecord $1 } | par(closed_irrefutable) { PPar $1 } -| Constr { - let value = $1, None - and region = $1.region in PConstr (PConstrApp {value; region}) } +| "" { PConstr (PConstrApp {$1 with value = $1,None}) } closed_irrefutable: - irrefutable { - $1 } -| Constr sub_pattern { + irrefutable +| typed_pattern { $1 } +| "" sub_pattern { let stop = pattern_to_region $2 in let region = cover $1.region stop - and value = $1, Some $2 - in PConstr (PConstrApp {value; region}) } -| typed_pattern { - PTyped $1 } + and value = $1, Some $2 in + PConstr (PConstrApp {region; value}) } typed_pattern: - irrefutable COLON type_expr { + irrefutable ":" type_expr { let start = pattern_to_region $1 in let stop = type_expr_to_region $3 in let region = cover start stop in - let value = { - pattern = $1; - colon = $2; - type_expr = $3} - in {value; region} } + let value = {pattern=$1; colon=$2; type_expr=$3} + in PTyped {region; value} } pattern: - sub_pattern CONS tail { - let start = pattern_to_region $1 in - let stop = pattern_to_region $3 in - let region = cover start stop - and value = $1, $2, $3 in - PList (PCons {region; value}) + core_pattern { $1 } +| sub_pattern "::" tail { + let start = pattern_to_region $1 in + let stop = pattern_to_region $3 in + let region = cover start stop in + PList (PCons {region; value=$1,$2,$3}) } | tuple(sub_pattern) { let start = pattern_to_region (fst $1) in let stop = last fst (snd $1) in let region = cover start stop - in PTuple {value=$1; region} - } -| core_pattern { $1 } + in PTuple {region; value=$1} } sub_pattern: par(tail) { PPar $1 } | core_pattern { $1 } core_pattern: - Ident { PVar $1 } -| WILD { PWild $1 } -| Int { PInt $1 } -| Nat { PNat $1 } -| Bytes { PBytes $1 } -| String { PString $1 } -| unit { PUnit $1 } -| False { PFalse $1 } -| True { PTrue $1 } -| par(ptuple) { PPar $1 } + "" { PVar $1 } +| "_" { PWild $1 } +| "" { PInt $1 } +| "" { PNat $1 } +| "" { PBytes $1 } +| "" { PString $1 } +| unit { PUnit $1 } +| "false" { PFalse $1 } +| "true" { PTrue $1 } +| par(ptuple) { PPar $1 } | list(tail) { PList (PListComp $1) } -| constr_pattern { PConstr $1 } -| record_pattern { PRecord $1 } +| constr_pattern { PConstr $1 } +| record_pattern { PRecord $1 } record_pattern: - LBRACE sep_or_term_list(field_pattern,SEMI) RBRACE { + "{" sep_or_term_list(field_pattern,";") "}" { let ne_elements, terminator = $2 in let region = cover $1 $3 in - let value = { - compound = Braces ($1,$3); - ne_elements; - terminator} + let value = {compound = Braces ($1,$3); ne_elements; terminator} in {region; value} } field_pattern: - field_name EQ sub_pattern { + field_name "=" sub_pattern { let start = $1.region and stop = pattern_to_region $3 in let region = cover start stop and value = {field_name=$1; eq=$2; pattern=$3} - in {value; region} } + in {region; value} } constr_pattern: - C_None { PNone $1 } -| C_Some sub_pattern { + "None" { PNone $1 } +| "Some" sub_pattern { let stop = pattern_to_region $2 in let region = cover $1 stop - and value = $1, $2 - in PSomeApp {value; region} - } -| Constr sub_pattern? { - let start = $1.region in - let stop = - match $2 with - Some p -> pattern_to_region p - | None -> start in - let region = cover start stop and value = $1,$2 - in PConstrApp {value; region} } + in PSomeApp {region; value} + } +| "" { + PConstrApp {$1 with value=$1,None} + } +| "" sub_pattern { + let region = cover $1.region (pattern_to_region $2) + in PConstrApp {region; value = $1, Some $2} } ptuple: tuple(tail) { - let h, t = $1 in - let start = pattern_to_region h in - let stop = last fst t in - let region = cover start stop in - PTuple {value = $1; region} } + let hd, tl = $1 in + let start = pattern_to_region hd in + let stop = last fst tl in + let region = cover start stop + in PTuple {region; value=$1} } unit: - LPAR RPAR { - let value = ghost, ghost in - let region = cover $1 $2 - in {value; region} } + "(" ")" { {region = cover $1 $2; value = ghost, ghost} } tail: - sub_pattern CONS tail { - let start = pattern_to_region $1 in - let stop = pattern_to_region $3 in + sub_pattern { $1 } +| sub_pattern "::" tail { + let start = pattern_to_region $1 in + let stop = pattern_to_region $3 in let region = cover start stop in - PList (PCons {value = ($1, $2, $3); region} ) - } -| sub_pattern { - $1 } + PList (PCons {region; value=$1,$2,$3}) } (* Expressions *) @@ -414,72 +345,67 @@ interactive_expr: expr EOF { $1 } expr: - base_cond__open(expr) { $1 } -| match_expr(base_cond) { ECase $1 } + base_cond__open(expr) | match_expr(base_cond) { $1 } base_cond__open(x): - base_expr(x) -| conditional(x) { $1 } + base_expr(x) | conditional(x) { $1 } base_cond: base_cond__open(base_cond) { $1 } base_expr(right_expr): + tuple_expr +| let_expr(right_expr) +| fun_expr(right_expr) +| disj_expr_level { $1 } + +tuple_expr: tuple(disj_expr_level) { let start = expr_to_region (fst $1) in let stop = last fst (snd $1) in let region = cover start stop - in ETuple {value=$1; region} - } -| let_expr(right_expr) -| fun_expr(right_expr) -| disj_expr_level { - $1 } + in ETuple {region; value=$1} } conditional(right_expr): - if_then_else(right_expr) -| if_then(right_expr) { ECond $1 } - -if_then(right_expr): - If expr Then right_expr { - let the_unit = ghost, ghost in - let ifnot = EUnit {region=ghost; value=the_unit} in - let stop = expr_to_region $4 in - let region = cover $1 stop in - let value = { - kwd_if = $1; - test = $2; - kwd_then = $3; - ifso = $4; - kwd_else = ghost; - ifnot} - in {value; region} } + if_then_else(right_expr) | if_then(right_expr) { $1 } if_then_else(right_expr): - If expr Then closed_if Else right_expr { + "if" expr "then" closed_if "else" right_expr { let region = cover $1 (expr_to_region $6) - and value = { - kwd_if = $1; - test = $2; - kwd_then = $3; - ifso = $4; - kwd_else = $5; - ifnot = $6} - in {value; region} } + and value = {kwd_if = $1; + test = $2; + kwd_then = $3; + ifso = $4; + kwd_else = $5; + ifnot = $6} + in ECond {region; value} } + +if_then(right_expr): + "if" expr "then" right_expr { + let the_unit = ghost, ghost in + let ifnot = EUnit (wrap_ghost the_unit) in + let stop = expr_to_region $4 in + let region = cover $1 stop in + let value = {kwd_if = $1; + test = $2; + kwd_then = $3; + ifso = $4; + kwd_else = ghost; + ifnot} + in ECond {region; value} } base_if_then_else__open(x): - base_expr(x) { $1 } -| if_then_else(x) { ECond $1 } + base_expr(x) | if_then_else(x) { $1 } base_if_then_else: - base_if_then_else__open(base_if_then_else) { $1 } + base_if_then_else__open(base_if_then_else) { $1 } closed_if: - base_if_then_else__open(closed_if) { $1 } -| match_expr(base_if_then_else) { ECase $1 } + base_if_then_else__open(closed_if) +| match_expr(base_if_then_else) { $1 } match_expr(right_expr): - Match expr With VBAR? cases(right_expr) { + "match" expr "with" "|"? cases(right_expr) { let cases = { value = Utils.nsepseq_rev $5; region = nsepseq_to_region (fun x -> x.region) $5} @@ -488,192 +414,144 @@ match_expr(right_expr): {region; _}, [] -> region | _, tl -> last fst tl in let region = cover $1 stop - and value = { - kwd_match = $1; - expr = $2; - kwd_with = $3; - lead_vbar = $4; - cases} - in {value; region} } + and value = {kwd_match = $1; + expr = $2; + kwd_with = $3; + lead_vbar = $4; + cases} + in ECase {region; value} } cases(right_expr): case_clause(right_expr) { let start = pattern_to_region $1.pattern and stop = expr_to_region $1.rhs in let region = cover start stop - in {value=$1; region}, [] + in {region; value=$1}, [] } -| cases(base_cond) VBAR case_clause(right_expr) { +| cases(base_cond) "|" case_clause(right_expr) { let start = match $1 with only_case, [] -> only_case.region | _, other_cases -> last fst other_cases - and stop = expr_to_region $3.rhs in - let region = cover start stop in - let fst_case = {value=$3; region} + and stop = expr_to_region $3.rhs in + let region = cover start stop in + let fst_case = {region; value=$3} and snd_case, others = $1 in fst_case, ($2,snd_case)::others } case_clause(right_expr): - pattern ARROW right_expr { - {pattern=$1; arrow=$2; rhs=$3} } + pattern "->" right_expr { {pattern=$1; arrow=$2; rhs=$3} } let_expr(right_expr): - Let let_binding In right_expr { - let kwd_let = $1 in - let binding = $2 in - let kwd_in = $3 in - let body = $4 in - let stop = expr_to_region $4 in - let region = cover $1 stop in - let let_in = {kwd_let; binding; kwd_in; body} - in ELetIn {region; value=let_in} } + "let" let_binding "in" right_expr { + let kwd_let = $1 + and binding = $2 + and kwd_in = $3 + and body = $4 in + let stop = expr_to_region body in + let region = cover kwd_let stop + and value = {kwd_let; binding; kwd_in; body} + in ELetIn {region; value} } fun_expr(right_expr): - Fun nseq(irrefutable) ARROW right_expr { + "fun" nseq(irrefutable) "->" right_expr { let stop = expr_to_region $4 in let region = cover $1 stop in - let f = { - kwd_fun = $1; - binders = $2; - lhs_type = None; - arrow = $3; - body = $4} - in EFun {region; value=f} } + let value = {kwd_fun = $1; + binders = $2; + lhs_type = None; + arrow = $3; + body = $4} + in EFun {region; value} } disj_expr_level: - disj_expr { ELogic (BoolExpr (Or $1)) } -| conj_expr_level { $1 } + bin_op(disj_expr_level, "||", conj_expr_level) +| bin_op(disj_expr_level, "or", conj_expr_level) { + ELogic (BoolExpr (Or $1)) } +| conj_expr_level { $1 } bin_op(arg1,op,arg2): arg1 op arg2 { let start = expr_to_region $1 in let stop = expr_to_region $3 in - let region = cover start stop in - {value={arg1=$1; op=$2; arg2=$3}; region} - } - -disj_expr: - bin_op(disj_expr_level, BOOL_OR, conj_expr_level) -| bin_op(disj_expr_level, Or, conj_expr_level) { $1 } + let region = cover start stop + and value = {arg1=$1; op=$2; arg2=$3} + in {region; value} } conj_expr_level: - conj_expr { ELogic (BoolExpr (And $1)) } -| comp_expr_level { $1 } - -conj_expr: - bin_op(conj_expr_level, BOOL_AND, comp_expr_level) { $1 } + bin_op(conj_expr_level, "&&", comp_expr_level) { + ELogic (BoolExpr (And $1)) } +| comp_expr_level { $1 } comp_expr_level: - lt_expr { ELogic (CompExpr (Lt $1)) } -| le_expr { ELogic (CompExpr (Leq $1)) } -| gt_expr { ELogic (CompExpr (Gt $1)) } -| ge_expr { ELogic (CompExpr (Geq $1)) } -| eq_expr { ELogic (CompExpr (Equal $1)) } -| ne_expr { ELogic (CompExpr (Neq $1)) } -| cat_expr_level { $1 } - -lt_expr: - bin_op(comp_expr_level, LT, cat_expr_level) { $1 } - -le_expr: - bin_op(comp_expr_level, LE, cat_expr_level) { $1 } - -gt_expr: - bin_op(comp_expr_level, GT, cat_expr_level) { $1 } - -ge_expr: - bin_op(comp_expr_level, GE, cat_expr_level) { $1 } - -eq_expr: - bin_op(comp_expr_level, EQ, cat_expr_level) { $1 } - -ne_expr: - bin_op(comp_expr_level, NE, cat_expr_level) { $1 } + bin_op(comp_expr_level, "<", cat_expr_level) { + ELogic (CompExpr (Lt $1)) } +| bin_op(comp_expr_level, "<=", cat_expr_level) { + ELogic (CompExpr (Leq $1)) } +| bin_op(comp_expr_level, ">", cat_expr_level) { + ELogic (CompExpr (Gt $1)) } +| bin_op(comp_expr_level, ">=", cat_expr_level) { + ELogic (CompExpr (Geq $1)) } +| bin_op(comp_expr_level, "=", cat_expr_level) { + ELogic (CompExpr (Equal $1)) } +| bin_op(comp_expr_level, "<>", cat_expr_level) { + ELogic (CompExpr (Neq $1)) } +| cat_expr_level { $1 } cat_expr_level: - cat_expr { EString (Cat $1) } -(*| reg(append_expr) { EList (Append $1) } *) -| cons_expr_level { $1 } - -cat_expr: - bin_op(cons_expr_level, CAT, cat_expr_level) { $1 } - -(* -append_expr: - cons_expr_level sym(APPEND) cat_expr_level { $1,$2,$3 } - *) + bin_op(cons_expr_level, "^", cat_expr_level) { EString (Cat $1) } +(*| reg(append_expr) { + bin_op(cons_expr_level, "@", cat_expr_level) { EList (Append $1) } *) +| cons_expr_level { $1 } cons_expr_level: - cons_expr { EList (ECons $1) } -| add_expr_level { $1 } - -cons_expr: - bin_op(add_expr_level, CONS, cons_expr_level) { $1 } + bin_op(add_expr_level, "::", cons_expr_level) { EList (ECons $1) } +| add_expr_level { $1 } add_expr_level: - plus_expr { EArith (Add $1) } -| minus_expr { EArith (Sub $1) } -| mult_expr_level { $1 } - -plus_expr: - bin_op(add_expr_level, PLUS, mult_expr_level) { $1 } - -minus_expr: - bin_op(add_expr_level, MINUS, mult_expr_level) { $1 } + bin_op(add_expr_level, "+", mult_expr_level) { EArith (Add $1) } +| bin_op(add_expr_level, "-", mult_expr_level) { EArith (Sub $1) } +| mult_expr_level { $1 } mult_expr_level: - times_expr { EArith (Mult $1) } -| div_expr { EArith (Div $1) } -| mod_expr { EArith (Mod $1) } -| unary_expr_level { $1 } - -times_expr: - bin_op(mult_expr_level, TIMES, unary_expr_level) { $1 } - -div_expr: - bin_op(mult_expr_level, SLASH, unary_expr_level) { $1 } - -mod_expr: - bin_op(mult_expr_level, Mod, unary_expr_level) { $1 } + bin_op(mult_expr_level, "*", unary_expr_level) { EArith (Mult $1) } +| bin_op(mult_expr_level, "/", unary_expr_level) { EArith (Div $1) } +| bin_op(mult_expr_level, "mod", unary_expr_level) { EArith (Mod $1) } +| unary_expr_level { $1 } unary_expr_level: - MINUS call_expr_level { + call_expr_level { $1 } +| "-" call_expr_level { let start = $1 in let stop = expr_to_region $2 in let region = cover start stop - and value = {op = $1; arg = $2} - in EArith (Neg {region; value}) } -| Not call_expr_level { + and value = {op=$1; arg=$2} + in EArith (Neg {region; value}) + } +| "not" call_expr_level { let start = $1 in let stop = expr_to_region $2 in let region = cover start stop - and value = {op = $1; arg = $2} in + and value = {op=$1; arg=$2} in ELogic (BoolExpr (Not ({region; value}))) } -| call_expr_level { - $1 } call_expr_level: - call_expr { ECall $1 } -| constr_expr { EConstr $1 } -| core_expr { $1 } + call_expr | constr_expr | core_expr { $1 } constr_expr: - C_None { - ENone $1 + "None" { + EConstr (ENone $1) } -| C_Some core_expr { +| "Some" core_expr { let region = cover $1 (expr_to_region $2) - in ESomeApp {value = $1,$2; region} + in EConstr (ESomeApp {region; value=$1,$2}) } -| Constr core_expr? { - let start = $1.region in - let stop = - match $2 with - Some c -> expr_to_region c - | None -> start in - let region = cover start stop - in EConstrApp {value=$1,$2; region} } +| "" core_expr { + let region = cover $1.region (expr_to_region $2) in + EConstr (EConstrApp {region; value=$1, Some $2}) + } +| "" { + EConstr (EConstrApp {$1 with value=$1, None}) } call_expr: core_expr nseq(core_expr) { @@ -682,92 +560,77 @@ call_expr: e, [] -> expr_to_region e | _, l -> last expr_to_region l in let region = cover start stop in - {value = $1,$2; region} } + ECall {region; value=$1,$2} } core_expr: - Int { EArith (Int $1) } -| Mutez { EArith (Mutez $1) } -| Nat { EArith (Nat $1) } -| Ident | module_field { EVar $1 } + "" { EArith (Int $1) } +| "" { EArith (Mutez $1) } +| "" { EArith (Nat $1) } +| "" | module_field { EVar $1 } | projection { EProj $1 } -| String { EString (String $1) } +| "" { EString (String $1) } | unit { EUnit $1 } -| False { ELogic (BoolExpr (False $1)) } -| True { ELogic (BoolExpr (True $1)) } +| "false" { ELogic (BoolExpr (False $1)) } +| "true" { ELogic (BoolExpr (True $1)) } | list(expr) { EList (EListComp $1) } -| par(expr) { EPar $1 } | sequence { ESeq $1 } | record_expr { ERecord $1 } -| par(expr COLON type_expr {$1,$3}) { - EAnnot {$1 with value=$1.value.inside} } +| par(expr) { EPar $1 } +| par(expr ":" type_expr {$1,$2,$3}) { EAnnot $1 } module_field: - module_name DOT field_name { + module_name "." field_name { let region = cover $1.region $3.region in - {value = $1.value ^ "." ^ $3.value; region} } + {region; value = $1.value ^ "." ^ $3.value} } projection: - struct_name DOT nsepseq(selection,DOT) { + struct_name "." nsepseq(selection,".") { let start = $1.region in let stop = nsepseq_to_region selection_to_region $3 in let region = cover start stop in - let value = { - struct_name = $1; - selector = $2; - field_path = $3} - in {value; region} + let value = {struct_name=$1; selector=$2; field_path=$3} + in {region; value} } -| module_name DOT field_name DOT nsepseq(selection,DOT) { - let value = $1.value ^ "." ^ $3.value in +| module_name "." field_name "." nsepseq(selection,".") { + let value = $1.value ^ "." ^ $3.value in let struct_name = {$1 with value} in - let start = $1.region in - let stop = nsepseq_to_region selection_to_region $5 in - let region = cover start stop in - let value = { - struct_name; - selector = $4; - field_path = $5} - in {value; region} } + let start = $1.region in + let stop = nsepseq_to_region selection_to_region $5 in + let region = cover start stop in + let value = {struct_name; selector=$4; field_path=$5} + in {region; value} } selection: field_name { FieldName $1 } -| Int { Component $1 } +| "" { Component $1 } record_expr: - LBRACE sep_or_term_list(field_assignment,SEMI) RBRACE { + "{" sep_or_term_list(field_assignment,";") "}" { let ne_elements, terminator = $2 in let region = cover $1 $3 in - let value = { - compound = Braces ($1,$3); - ne_elements; - terminator} - in {value; region} } + let value = {compound = Braces ($1,$3); + ne_elements; + terminator} + in {region; value} } field_assignment: - field_name EQ expr { + field_name "=" expr { let start = $1.region in let stop = expr_to_region $3 in let region = cover start stop in - let value = { - field_name = $1; - assignment = $2; - field_expr = $3} - in {value; region} } + let value = {field_name = $1; + assignment = $2; + field_expr = $3} + in {region; value} } sequence: - Begin sep_or_term_list(expr,SEMI) End { - let ne_elements, terminator = $2 in - let value = { - compound = BeginEnd ($1,$3); - elements = Some ne_elements; - terminator} in - let region = cover $1 $3 - in {value; region} - } -| Begin End { - let value = { - compound = BeginEnd ($1,$2); - elements = None; - terminator = None} in - let region = cover $1 $2 - in {value; region} } + "begin" sep_or_term_list(expr,";")? "end" { + let region = cover $1 $3 + and compound = BeginEnd ($1,$3) in + let elements, terminator = + match $2 with + None -> None, None + | Some (ne_elements, terminator) -> + Some ne_elements, terminator in + let value = {compound; elements; terminator} + in {region; value} } diff --git a/src/passes/1-parser/cameligo/ParserLog.ml b/src/passes/1-parser/cameligo/ParserLog.ml index 334ee11be..20aab4c9d 100644 --- a/src/passes/1-parser/cameligo/ParserLog.ml +++ b/src/passes/1-parser/cameligo/ParserLog.ml @@ -369,10 +369,13 @@ and print_fun_call state {value=f,l; _} = print_expr state f; Utils.nseq_iter (print_expr state) l -and print_annot_expr state {value=e,t; _} = - print_expr state e; - print_token state Region.ghost ":"; - print_type_expr state t +and print_annot_expr state {value; _} = + let {lpar; inside=e,colon,t; rpar} = value in + print_token state lpar "("; + print_expr state e; + print_token state colon ":"; + print_type_expr state t; + print_token state rpar ")" and print_list_expr state = function ECons {value={arg1;op;arg2}; _} -> @@ -738,7 +741,7 @@ and pp_expr state = function pp_loc_node state "ECond" region; pp_cond_expr state value | EAnnot {value; region} -> - pp_loc_node state "EAnnot" region; + pp_loc_node state "EAnnot" region; pp_annotated state value | ELogic e_logic -> pp_node state "ELogic"; @@ -967,7 +970,8 @@ and pp_bin_op node region state op = pp_expr (state#pad 2 0) op.arg1; pp_expr (state#pad 2 1) op.arg2 -and pp_annotated state (expr, t_expr) = +and pp_annotated state annot = + let expr, _, t_expr = annot.inside in pp_expr (state#pad 2 0) expr; pp_type_expr (state#pad 2 1) t_expr diff --git a/src/passes/1-parser/pascaligo/LexToken.mli b/src/passes/1-parser/pascaligo/LexToken.mli index 379892d82..b1865faad 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mli +++ b/src/passes/1-parser/pascaligo/LexToken.mli @@ -35,7 +35,7 @@ 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 diff --git a/src/passes/1-parser/pascaligo/ParToken.mly b/src/passes/1-parser/pascaligo/ParToken.mly index 08f734998..629ab9d85 100644 --- a/src/passes/1-parser/pascaligo/ParToken.mly +++ b/src/passes/1-parser/pascaligo/ParToken.mly @@ -5,86 +5,86 @@ (* Literals *) -%token String -%token <(LexToken.lexeme * Hex.t) Region.reg> Bytes -%token <(LexToken.lexeme * Z.t) Region.reg> Int -%token <(LexToken.lexeme * Z.t) Region.reg> Nat -%token <(LexToken.lexeme * Z.t) Region.reg> Mutez -%token Ident -%token Constr +%token String "" +%token <(LexToken.lexeme * Hex.t) Region.reg> Bytes "" +%token <(LexToken.lexeme * Z.t) Region.reg> Int "" +%token <(LexToken.lexeme * Z.t) Region.reg> Nat "" +%token <(LexToken.lexeme * Z.t) Region.reg> Mutez "" +%token Ident "" +%token Constr "" (* Symbols *) -%token SEMI (* ";" *) -%token COMMA (* "," *) -%token LPAR (* "(" *) -%token RPAR (* ")" *) -%token LBRACE (* "{" *) -%token RBRACE (* "}" *) -%token LBRACKET (* "[" *) -%token RBRACKET (* "]" *) -%token CONS (* "#" *) -%token VBAR (* "|" *) -%token ARROW (* "->" *) -%token ASS (* ":=" *) -%token EQ (* "=" *) -%token COLON (* ":" *) -%token LT (* "<" *) -%token LE (* "<=" *) -%token GT (* ">" *) -%token GE (* ">=" *) -%token NE (* "=/=" *) -%token PLUS (* "+" *) -%token MINUS (* "-" *) -%token SLASH (* "/" *) -%token TIMES (* "*" *) -%token DOT (* "." *) -%token WILD (* "_" *) -%token CAT (* "^" *) +%token SEMI ";" +%token COMMA "," +%token LPAR "(" +%token RPAR ")" +%token LBRACE "{" +%token RBRACE "}" +%token LBRACKET "[" +%token RBRACKET "]" +%token CONS "#" +%token VBAR "|" +%token ARROW "->" +%token ASS ":=" +%token EQ "=" +%token COLON ":" +%token LT "<" +%token LE "<=" +%token GT ">" +%token GE ">=" +%token NE "=/=" +%token PLUS "+" +%token MINUS "-" +%token SLASH "/" +%token TIMES "*" +%token DOT "." +%token WILD "_" +%token CAT "^" (* Keywords *) -%token And (* "and" *) -%token Begin (* "begin" *) -%token BigMap (* "big_map" *) -%token Block (* "block" *) -%token Case (* "case" *) -%token Const (* "const" *) -%token Contains (* "contains" *) -%token Else (* "else" *) -%token End (* "end" *) -%token False (* "False" *) -%token For (* "for" *) -%token Function (* "function" *) -%token From (* "from" *) -%token If (* "if" *) -%token In (* "in" *) -%token Is (* "is" *) -%token List (* "list" *) -%token Map (* "map" *) -%token Mod (* "mod" *) -%token Nil (* "nil" *) -%token Not (* "not" *) -%token Of (* "of" *) -%token Or (* "or" *) -%token Patch (* "patch" *) -%token Record (* "record" *) -%token Remove (* "remove" *) -%token Set (* "set" *) -%token Skip (* "skip" *) -%token Then (* "then" *) -%token To (* "to" *) -%token True (* "True" *) -%token Type (* "type" *) -%token Unit (* "Unit" *) -%token Var (* "var" *) -%token While (* "while" *) -%token With (* "with" *) +%token And "and" +%token Begin "begin" +%token BigMap "big_map" +%token Block "block" +%token Case "case" +%token Const "const" +%token Contains "contains" +%token Else "else" +%token End "end" +%token False "False" +%token For "for" +%token Function "function" +%token From "from" +%token If "if" +%token In "in" +%token Is "is" +%token List "list" +%token Map "map" +%token Mod "mod" +%token Nil "nil" +%token Not "not" +%token Of "of" +%token Or "or" +%token Patch "patch" +%token Record "record" +%token Remove "remove" +%token Set "set" +%token Skip "skip" +%token Then "then" +%token To "to" +%token True "True" +%token Type "type" +%token Unit "Unit" +%token Var "var" +%token While "while" +%token With "with" (* Data constructors *) -%token C_None (* "None" *) -%token C_Some (* "Some" *) +%token C_None "None" +%token C_Some "Some" (* Virtual tokens *) diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 01eb227fb..829bbbc11 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -41,24 +41,22 @@ sep_or_term_list(item,sep): (* Compound constructs *) par(X): - LPAR X RPAR { + "(" X ")" { let region = cover $1 $3 and value = { lpar = $1; inside = $2; rpar = $3} - in {region; value} - } + in {region; value} } brackets(X): - LBRACKET X RBRACKET { + "[" X "]" { let region = cover $1 $3 and value = { lbracket = $1; inside = $2; rbracket = $3} - in {region; value} - } + in {region; value} } (* Sequences @@ -100,18 +98,17 @@ sepseq(X,Sep): (* Inlines *) -%inline var : Ident { $1 } -%inline type_name : Ident { $1 } -%inline fun_name : Ident { $1 } -%inline field_name : Ident { $1 } -%inline struct_name : Ident { $1 } +%inline var : "" { $1 } +%inline type_name : "" { $1 } +%inline fun_name : "" { $1 } +%inline field_name : "" { $1 } +%inline struct_name : "" { $1 } (* Main *) contract: nseq(declaration) EOF { - {decl = $1; eof = $2} - } + {decl = $1; eof = $2} } declaration: type_decl { TypeDecl $1 } @@ -121,7 +118,7 @@ declaration: (* Type declarations *) type_decl: - Type type_name Is type_expr option(SEMI) { + "type" type_name "is" type_expr ";"? { let stop = match $5 with Some region -> region @@ -133,8 +130,7 @@ type_decl: kwd_is = $3; type_expr = $4; terminator = $5} - in {region; value} - } + in {region; value} } type_expr: sum_type { TSum $1 } @@ -142,7 +138,7 @@ type_expr: | cartesian { $1 } cartesian: - function_type TIMES nsepseq(function_type,TIMES) { + function_type "*" nsepseq(function_type,"*") { let value = Utils.nsepseq_cons $1 $2 $3 in let region = nsepseq_to_region type_expr_to_region value in TProd {region; value} @@ -153,7 +149,7 @@ function_type: core_type { $1 } -| core_type ARROW function_type { +| core_type "->" function_type { let start = type_expr_to_region $1 and stop = type_expr_to_region $3 in let region = cover start stop in @@ -167,24 +163,24 @@ core_type: let region = cover $1.region $2.region in TApp {region; value = $1,$2} } -| Map type_tuple { +| "map" type_tuple { let region = cover $1 $2.region in let type_constr = {value="map"; region=$1} in TApp {region; value = type_constr, $2} } -| BigMap type_tuple { +| "big_map" type_tuple { let region = cover $1 $2.region in let type_constr = {value="big_map"; region=$1} in TApp {region; value = type_constr, $2} } -| Set par(type_expr) { +| "set" par(type_expr) { let total = cover $1 $2.region in let type_constr = {value="set"; region=$1} in let {region; value = {lpar; inside; rpar}} = $2 in let tuple = {region; value={lpar; inside=inside,[]; rpar}} in TApp {region=total; value = type_constr, tuple} } -| List par(type_expr) { +| "list" par(type_expr) { let total = cover $1 $2.region in let type_constr = {value="list"; region=$1} in let {region; value = {lpar; inside; rpar}} = $2 in @@ -195,24 +191,24 @@ core_type: TPar $1} type_tuple: - par(nsepseq(type_expr,COMMA)) { $1 } + par(nsepseq(type_expr,",")) { $1 } sum_type: - option(VBAR) nsepseq(variant,VBAR) { + "|"? nsepseq(variant,"|") { let region = nsepseq_to_region (fun x -> x.region) $2 in {region; value=$2} } variant: - Constr Of cartesian { + "" "of" cartesian { let region = cover $1.region (type_expr_to_region $3) - and value = {constr = $1; arg = Some ($2, $3)} + and value = {constr = $1; arg = Some ($2, $3)} in {region; value} } -| Constr { +| "" { {region=$1.region; value= {constr=$1; arg=None}} } record_type: - Record sep_or_term_list(field_decl,SEMI) End { + "record" sep_or_term_list(field_decl,";") "end" { let ne_elements, terminator = $2 in let region = cover $1 $3 and value = { @@ -222,7 +218,7 @@ record_type: closing = End $3} in {region; value} } -| Record LBRACKET sep_or_term_list(field_decl,SEMI) RBRACKET { +| "record" "[" sep_or_term_list(field_decl,";") "]" { let ne_elements, terminator = $3 in let region = cover $1 $4 and value = { @@ -233,19 +229,19 @@ record_type: in {region; value} } field_decl: - field_name COLON type_expr { + field_name ":" type_expr { let stop = type_expr_to_region $3 in let region = cover $1.region stop and value = {field_name = $1; colon = $2; field_type = $3} in {region; value} } fun_expr: - Function option(fun_name) parameters COLON type_expr Is - block - With expr { - let stop = expr_to_region $9 in + "function" fun_name? parameters ":" type_expr "is" + block + "with" expr { + let stop = expr_to_region $9 in let region = cover $1 stop - and value = { + and value = { kwd_function = $1; name = $2; param = $3; @@ -255,27 +251,25 @@ fun_expr: block_with = Some ($7, $8); return = $9} in {region;value} } - | Function option(fun_name) parameters COLON type_expr Is - expr { - let stop = expr_to_region $7 in - let region = cover $1 stop - and value = { - kwd_function = $1; - name = $2; - param = $3; - colon = $4; - ret_type = $5; - kwd_is = $6; - block_with = None; - return = $7} - in {region;value}} - +| "function" fun_name? parameters ":" type_expr "is" expr { + let stop = expr_to_region $7 in + let region = cover $1 stop + and value = { + kwd_function = $1; + name = $2; + param = $3; + colon = $4; + ret_type = $5; + kwd_is = $6; + block_with = None; + return = $7} + in {region;value} } (* Function declarations *) fun_decl: - fun_expr option(SEMI) { + fun_expr ";"? { let stop = match $2 with Some region -> region @@ -289,16 +283,16 @@ fun_decl: open_fun_decl: fun_expr { let region = $1.region - and value = { + and value = { fun_expr = $1; terminator = None} in {region; value} } parameters: - par(nsepseq(param_decl,SEMI)) { $1 } + par(nsepseq(param_decl,";")) { $1 } param_decl: - Var var COLON param_type { + "var" var ":" param_type { let stop = type_expr_to_region $4 in let region = cover $1 stop and value = { @@ -308,7 +302,7 @@ param_decl: param_type = $4} in ParamVar {region; value} } -| Const var COLON param_type { +| "const" var ":" param_type { let stop = type_expr_to_region $4 in let region = cover $1 stop and value = { @@ -316,31 +310,31 @@ param_decl: var = $2; colon = $3; param_type = $4} - in ParamConst {region; value}} + in ParamConst {region; value} } param_type: cartesian { $1 } block: - Begin sep_or_term_list(statement,SEMI) End { - let statements, terminator = $2 in - let region = cover $1 $3 - and value = { - opening = Begin $1; - statements; - terminator; - closing = End $3} - in {region; value} + "begin" sep_or_term_list(statement,";") "end" { + let statements, terminator = $2 in + let region = cover $1 $3 + and value = { + opening = Begin $1; + statements; + terminator; + closing = End $3} + in {region; value} } -| Block LBRACE sep_or_term_list(statement,SEMI) RBRACE { - let statements, terminator = $3 in - let region = cover $1 $4 - and value = { - opening = Block ($1,$2); - statements; - terminator; - closing = Block $4} - in {region; value}} +| "block" "{" sep_or_term_list(statement,";") "}" { + let statements, terminator = $3 in + let region = cover $1 $4 + and value = { + opening = Block ($1,$2); + statements; + terminator; + closing = Block $4} + in {region; value} } statement: instruction { Instr $1 } @@ -352,7 +346,7 @@ open_data_decl: | open_fun_decl { LocalFun $1 } open_const_decl: - Const unqualified_decl(EQ) { + "const" unqualified_decl("=") { let name, colon, const_type, equal, init, stop = $2 in let region = cover $1 stop and value = { @@ -363,10 +357,10 @@ open_const_decl: equal; init; terminator = None} - in {region; value}} + in {region; value} } open_var_decl: - Var unqualified_decl(ASS) { + "var" unqualified_decl(":=") { let name, colon, var_type, assign, init, stop = $2 in let region = cover $1 stop and value = { @@ -377,15 +371,15 @@ open_var_decl: assign; init; terminator = None} - in {region; value}} + in {region; value} } unqualified_decl(OP): - var COLON type_expr OP expr { + var ":" type_expr OP expr { let region = expr_to_region $5 - in $1, $2, $3, $4, $5, region} + in $1, $2, $3, $4, $5, region } const_decl: - open_const_decl SEMI { + open_const_decl ";" { let const_decl : AST.const_decl = $1.value in {$1 with value = {const_decl with terminator = Some $2}} } @@ -398,7 +392,7 @@ instruction: | assignment { Assign $1 } | loop { Loop $1 } | proc_call { ProcCall $1 } -| Skip { Skip $1 } +| "skip" { Skip $1 } | record_patch { RecordPatch $1 } | map_patch { MapPatch $1 } | set_patch { SetPatch $1 } @@ -406,7 +400,7 @@ instruction: | set_remove { SetRemove $1 } set_remove: - Remove expr From Set path { + "remove" expr "from" "set" path { let region = cover $1 (path_to_region $5) in let value = { kwd_remove = $1; @@ -414,10 +408,10 @@ set_remove: kwd_from = $3; kwd_set = $4; set = $5} - in {region; value}} + in {region; value} } map_remove: - Remove expr From Map path { + "remove" expr "from" "map" path { let region = cover $1 (path_to_region $5) in let value = { kwd_remove = $1; @@ -425,30 +419,30 @@ map_remove: kwd_from = $3; kwd_map = $4; map = $5} - in {region; value}} + in {region; value} } set_patch: - Patch path With ne_injection(Set,expr) { + "patch" path "with" ne_injection("set",expr) { let region = cover $1 $4.region in let value = { kwd_patch = $1; path = $2; kwd_with = $3; set_inj = $4} - in {region; value}} + in {region; value} } map_patch: - Patch path With ne_injection(Map,binding) { + "patch" path "with" ne_injection("map",binding) { let region = cover $1 $4.region in let value = { kwd_patch = $1; path = $2; kwd_with = $3; map_inj = $4} - in {region; value}} + in {region; value} } injection(Kind,element): - Kind sep_or_term_list(element,SEMI) End { + Kind sep_or_term_list(element,";") "end" { let elements, terminator = $2 in let region = cover $1 $3 and value = { @@ -458,7 +452,7 @@ injection(Kind,element): closing = End $3} in {region; value} } -| Kind End { +| Kind "end" { let region = cover $1 $2 and value = { opening = Kwd $1; @@ -467,7 +461,7 @@ injection(Kind,element): closing = End $2} in {region; value} } -| Kind LBRACKET sep_or_term_list(element,SEMI) RBRACKET { +| Kind "[" sep_or_term_list(element,";") "]" { let elements, terminator = $3 in let region = cover $1 $4 and value = { @@ -477,17 +471,17 @@ injection(Kind,element): closing = RBracket $4} in {region; value} } -| Kind LBRACKET RBRACKET { +| Kind "[" "]" { let region = cover $1 $3 and value = { opening = KwdBracket ($1,$2); elements = None; terminator = None; closing = RBracket $3} - in {region; value}} + in {region; value} } ne_injection(Kind,element): - Kind sep_or_term_list(element,SEMI) End { + Kind sep_or_term_list(element,";") "end" { let ne_elements, terminator = $2 in let region = cover $1 $3 and value = { @@ -497,7 +491,7 @@ ne_injection(Kind,element): closing = End $3} in {region; value} } -| Kind LBRACKET sep_or_term_list(element,SEMI) RBRACKET { +| Kind "[" sep_or_term_list(element,";") "]" { let ne_elements, terminator = $3 in let region = cover $1 $4 and value = { @@ -505,11 +499,10 @@ ne_injection(Kind,element): ne_elements; terminator; closing = RBracket $4} - in {region; value} - } + in {region; value} } binding: - expr ARROW expr { + expr "->" expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -517,23 +510,23 @@ binding: source = $1; arrow = $2; image = $3} - in {region; value}} + in {region; value} } record_patch: - Patch path With ne_injection(Record,field_assignment) { + "patch" path "with" ne_injection("record",field_assignment) { let region = cover $1 $4.region in let value = { kwd_patch = $1; path = $2; kwd_with = $3; record_inj = $4} - in {region; value}} + in {region; value} } proc_call: fun_call { $1 } conditional: - If expr Then if_clause option(SEMI) Else if_clause { + "if" expr "then" if_clause ";"? "else" if_clause { let region = cover $1 (if_clause_to_region $7) in let value : conditional = { kwd_if = $1; @@ -552,7 +545,7 @@ if_clause: clause_block: block { LongBlock $1 } -| LBRACE sep_or_term_list(statement,SEMI) RBRACE { +| "{" sep_or_term_list(statement,";") "}" { let region = cover $1 $3 in let value = { lbrace = $1; @@ -564,7 +557,7 @@ case_instr: case(if_clause) { $1 if_clause_to_region } case(rhs): - Case expr Of option(VBAR) cases(rhs) End { + "case" expr "of" "|"? cases(rhs) "end" { fun rhs_to_region -> let region = cover $1 $6 in let value = { @@ -576,7 +569,7 @@ case(rhs): closing = End $6} in {region; value} } -| Case expr Of LBRACKET option(VBAR) cases(rhs) RBRACKET { +| "case" expr "of" "[" "|"? cases(rhs) "]" { fun rhs_to_region -> let region = cover $1 $7 in let value = { @@ -586,30 +579,30 @@ case(rhs): lead_vbar = $5; cases = $6 rhs_to_region; closing = RBracket $7} - in {region; value}} + in {region; value} } cases(rhs): - nsepseq(case_clause(rhs),VBAR) { + nsepseq(case_clause(rhs),"|") { fun rhs_to_region -> let mk_clause pre_clause = pre_clause rhs_to_region in let value = Utils.nsepseq_map mk_clause $1 in let region = nsepseq_to_region (fun x -> x.region) value - in {region; value}} + in {region; value} } case_clause(rhs): - pattern ARROW rhs { + pattern "->" rhs { fun rhs_to_region -> let start = pattern_to_region $1 in let region = cover start (rhs_to_region $3) and value = {pattern=$1; arrow=$2; rhs=$3} - in {region; value}} + in {region; value} } assignment: - lhs ASS rhs { + lhs ":=" rhs { let stop = rhs_to_region $3 in let region = cover (lhs_to_region $1) stop and value = {lhs = $1; assign = $2; rhs = $3} - in {region; value}} + in {region; value} } rhs: expr { $1 } @@ -623,16 +616,16 @@ loop: | for_loop { $1 } while_loop: - While expr block { + "while" expr block { let region = cover $1 $3.region and value = { kwd_while = $1; cond = $2; block = $3} - in While {region; value}} + in While {region; value} } for_loop: - For var_assign To expr block { + "for" var_assign "to" expr block { let region = cover $1 $5.region in let value = { kwd_for = $1; @@ -642,8 +635,7 @@ for_loop: block = $5} in For (ForInt {region; value}) } -| For var option(arrow_clause) - In collection expr block { +| "for" var arrow_clause? "in" collection expr block { let region = cover $1 $7.region in let value = { kwd_for = $1; @@ -653,21 +645,21 @@ for_loop: collection = $5; expr = $6; block = $7} - in For (ForCollect {region; value})} + in For (ForCollect {region; value}) } collection: - Map { Map $1 } -| Set { Set $1 } -| List { List $1 } + "map" { Map $1 } +| "set" { Set $1 } +| "list" { List $1 } var_assign: - var ASS expr { + var ":=" expr { let region = cover $1.region (expr_to_region $3) and value = {name = $1; assign = $2; expr = $3} - in {region; value}} + in {region; value} } arrow_clause: - ARROW var { $1,$2 } + "->" var { $1,$2 } (* Expressions *) @@ -681,7 +673,7 @@ expr: | fun_expr { EFun $1 } cond_expr: - If expr Then expr option(SEMI) Else expr { + "if" expr "then" expr ";"? "else" expr { let region = cover $1 (expr_to_region $7) in let value : cond_expr = { kwd_if = $1; @@ -694,7 +686,7 @@ cond_expr: in ECond {region; value} } disj_expr: - disj_expr Or conj_expr { + disj_expr "or" conj_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -704,7 +696,7 @@ disj_expr: | conj_expr { $1 } conj_expr: - conj_expr And set_membership { + conj_expr "and" set_membership { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -714,7 +706,7 @@ conj_expr: | set_membership { $1 } set_membership: - core_expr Contains set_membership { + core_expr "contains" set_membership { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop in @@ -727,42 +719,42 @@ set_membership: | comp_expr { $1 } comp_expr: - comp_expr LT cat_expr { + comp_expr "<" cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in ELogic (CompExpr (Lt {region; value})) } -| comp_expr LE cat_expr { +| comp_expr "<=" cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in ELogic (CompExpr (Leq {region; value})) } -| comp_expr GT cat_expr { +| comp_expr ">" cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in ELogic (CompExpr (Gt {region; value})) } -| comp_expr GE cat_expr { +| comp_expr ">=" cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in ELogic (CompExpr (Geq {region; value})) } -| comp_expr EQ cat_expr { +| comp_expr "=" cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in ELogic (CompExpr (Equal {region; value})) } -| comp_expr NE cat_expr { +| comp_expr "=/=" cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -772,7 +764,7 @@ comp_expr: | cat_expr { $1 } cat_expr: - cons_expr CAT cat_expr { + cons_expr "^" cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -782,7 +774,7 @@ cat_expr: | cons_expr { $1 } cons_expr: - add_expr CONS cons_expr { + add_expr "#" cons_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -792,14 +784,14 @@ cons_expr: | add_expr { $1 } add_expr: - add_expr PLUS mult_expr { + add_expr "+" mult_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in EArith (Add {region; value}) } -| add_expr MINUS mult_expr { +| add_expr "-" mult_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -809,21 +801,21 @@ add_expr: | mult_expr { $1 } mult_expr: - mult_expr TIMES unary_expr { + mult_expr "*" unary_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in EArith (Mult {region; value}) } -| mult_expr SLASH unary_expr { +| mult_expr "/" unary_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in EArith (Div {region; value}) } -| mult_expr Mod unary_expr { +| mult_expr "mod" unary_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -833,13 +825,13 @@ mult_expr: | unary_expr { $1 } unary_expr: - MINUS core_expr { + "-" core_expr { let stop = expr_to_region $2 in let region = cover $1 stop and value = {op = $1; arg = $2} in EArith (Neg {region; value}) } -| Not core_expr { +| "not" core_expr { let stop = expr_to_region $2 in let region = cover $1 stop and value = {op = $1; arg = $2} in @@ -848,101 +840,97 @@ unary_expr: | core_expr { $1 } core_expr: - Int { EArith (Int $1) } -| Nat { EArith (Nat $1) } -| Mutez { EArith (Mutez $1) } + "" { EArith (Int $1) } +| "" { EArith (Nat $1) } +| "" { EArith (Mutez $1) } | var { EVar $1 } -| String { EString (String $1) } -| Bytes { EBytes $1 } -| False { ELogic (BoolExpr (False $1)) } -| True { ELogic (BoolExpr (True $1)) } -| Unit { EUnit $1 } +| "" { EString (String $1) } +| "" { EBytes $1 } +| "False" { ELogic (BoolExpr (False $1)) } +| "True" { ELogic (BoolExpr (True $1)) } +| "Unit" { EUnit $1 } | annot_expr { EAnnot $1 } | tuple_expr { ETuple $1 } | list_expr { EList $1 } -| C_None { EConstr (NoneExpr $1) } -| fun_call_or_par_or_projection { $1 } +| "None" { EConstr (NoneExpr $1) } +| fun_call_or_par_or_projection { $1 } | map_expr { EMap $1 } | set_expr { ESet $1 } | record_expr { ERecord $1 } -| Constr arguments { +| "" arguments { let region = cover $1.region $2.region in EConstr (ConstrApp {region; value = $1, Some $2}) } -| Constr { +| "" { EConstr (ConstrApp {region=$1.region; value = $1,None}) } -| C_Some arguments { +| "Some" arguments { let region = cover $1 $2.region in - EConstr (SomeApp {region; value = $1,$2})} - + EConstr (SomeApp {region; value = $1,$2}) } fun_call_or_par_or_projection: -| par(expr) option(arguments) { - let parenthesized = EPar $1 in - match $2 with - | None -> parenthesized - | Some args -> ( - let region_1 = $1.region in - let region = cover region_1 args.region in - ECall {region; value = parenthesized,args} - ) -} -| projection option(arguments) { - let project = EProj $1 in - match $2 with - | None -> project - | Some args -> ( - let region_1 = $1.region in - let region = cover region_1 args.region in - ECall {region; value = project,args} - ) -} + par(expr) arguments? { + let parenthesized = EPar $1 in + match $2 with + None -> parenthesized + | Some args -> + let region_1 = $1.region in + let region = cover region_1 args.region in + ECall {region; value = parenthesized,args} + } +| projection arguments? { + let project = EProj $1 in + match $2 with + None -> project + | Some args -> + let region_1 = $1.region in + let region = cover region_1 args.region + in ECall {region; value = project,args} + } | fun_call { ECall $1 } annot_expr: - LPAR disj_expr COLON type_expr RPAR { + "(" disj_expr ":" type_expr ")" { let start = expr_to_region $2 and stop = type_expr_to_region $4 in let region = cover start stop - and value = ($2 , $4) - in {region; value} - } + and value = $2, $4 + in {region; value} } set_expr: - injection(Set,expr) { SetInj $1 } + injection("set",expr) { SetInj $1 } map_expr: - map_lookup { MapLookUp $1 } -| injection(Map,binding) { MapInj $1 } -| injection(BigMap,binding) { BigMapInj $1 } + map_lookup { MapLookUp $1 } +| injection("map",binding) { MapInj $1 } +| injection("big_map",binding) { BigMapInj $1 } map_lookup: path brackets(expr) { let region = cover (path_to_region $1) $2.region in let value = {path=$1; index=$2} - in {region; value}} + in {region; value} } path: var { Name $1 } | projection { Path $1 } projection: - struct_name DOT nsepseq(selection,DOT) { + struct_name "." nsepseq(selection,".") { let stop = nsepseq_to_region selection_to_region $3 in let region = cover $1.region stop and value = { struct_name = $1; selector = $2; field_path = $3} - in {region; value}} + in {region; value} } selection: field_name { FieldName $1 } -| Int { Component $1 } +| "" { Component $1 } record_expr: - Record sep_or_term_list(field_assignment,SEMI) End { + "record" sep_or_term_list(field_assignment,";") "end" { let ne_elements, terminator = $2 in let region = cover $1 $3 and value : field_assign AST.reg ne_injection = { @@ -952,7 +940,7 @@ record_expr: closing = End $3} in {region; value} } -| Record LBRACKET sep_or_term_list(field_assignment,SEMI) RBRACKET { +| "record" "[" sep_or_term_list(field_assignment,";") "]" { let ne_elements, terminator = $3 in let region = cover $1 $4 and value : field_assign AST.reg ne_injection = { @@ -963,76 +951,77 @@ record_expr: in {region; value} } field_assignment: - field_name EQ expr { + field_name "=" expr { let region = cover $1.region (expr_to_region $3) and value = { field_name = $1; equal = $2; field_expr = $3} - in {region; value}} + in {region; value} } fun_call: fun_name arguments { let region = cover $1.region $2.region - in {region; value = (EVar $1),$2}} + in {region; value = (EVar $1),$2} } tuple_expr: par(tuple_comp) { $1 } tuple_comp: - expr COMMA nsepseq(expr,COMMA) { - Utils.nsepseq_cons $1 $2 $3} + expr "," nsepseq(expr,",") { + Utils.nsepseq_cons $1 $2 $3 } arguments: - par(nsepseq(expr,COMMA)) { $1 } + par(nsepseq(expr,",")) { $1 } list_expr: - injection(List,expr) { EListComp $1 } -| Nil { ENil $1 } + injection("list",expr) { EListComp $1 } +| "nil" { ENil $1 } (* Patterns *) pattern: - core_pattern CONS nsepseq(core_pattern,CONS) { + core_pattern "#" nsepseq(core_pattern,"#") { let value = Utils.nsepseq_cons $1 $2 $3 in let region = nsepseq_to_region pattern_to_region value - in PList (PCons {region; value}) } + in PList (PCons {region; value}) + } | core_pattern { $1 } core_pattern: var { PVar $1 } -| WILD { PWild $1 } -| Int { PInt $1 } -| Nat { PNat $1 } -| Bytes { PBytes $1 } -| String { PString $1 } +| "_" { PWild $1 } +| "" { PInt $1 } +| "" { PNat $1 } +| "" { PBytes $1 } +| "" { PString $1 } | list_pattern { PList $1 } | tuple_pattern { PTuple $1 } | constr_pattern { PConstr $1 } list_pattern: - injection(List,core_pattern) { PListComp $1 } -| Nil { PNil $1 } -| par(cons_pattern) { PParCons $1 } + injection("list",core_pattern) { PListComp $1 } +| "nil" { PNil $1 } +| par(cons_pattern) { PParCons $1 } cons_pattern: - core_pattern CONS pattern { $1,$2,$3 } + core_pattern "#" pattern { $1,$2,$3 } tuple_pattern: - par(nsepseq(core_pattern,COMMA)) { $1 } + par(nsepseq(core_pattern,",")) { $1 } constr_pattern: - Unit { PUnit $1 } -| False { PFalse $1 } -| True { PTrue $1 } -| C_None { PNone $1 } -| C_Some par(core_pattern) { + "Unit" { PUnit $1 } +| "False" { PFalse $1 } +| "True" { PTrue $1 } +| "None" { PNone $1 } +| "Some" par(core_pattern) { let region = cover $1 $2.region in PSomeApp {region; value = $1,$2} } -| Constr tuple_pattern { - let region = cover $1.region $2.region - in PConstrApp {region; value = $1, Some $2} +| "" tuple_pattern { + let region = cover $1.region $2.region in + PConstrApp {region; value = $1, Some $2} } -| Constr { - PConstrApp {region=$1.region; value = $1, None} } +| "" { + PConstrApp {region=$1.region; value=$1,None} } diff --git a/src/passes/1-parser/pascaligo/Stubs/Simple_utils.ml b/src/passes/1-parser/pascaligo/Stubs/Simple_utils.ml new file mode 100644 index 000000000..0360af1b5 --- /dev/null +++ b/src/passes/1-parser/pascaligo/Stubs/Simple_utils.ml @@ -0,0 +1,2 @@ +module Region = Region +module Pos = Pos diff --git a/src/passes/1-parser/reasonligo/.LexerMain.tag b/src/passes/1-parser/reasonligo/.LexerMain.tag new file mode 100644 index 000000000..e69de29bb diff --git a/src/passes/1-parser/reasonligo/.Parser.mly.tag b/src/passes/1-parser/reasonligo/.Parser.mly.tag new file mode 100644 index 000000000..100f7bb69 --- /dev/null +++ b/src/passes/1-parser/reasonligo/.Parser.mly.tag @@ -0,0 +1 @@ +--explain --external-tokens LexToken --base Parser ParToken.mly diff --git a/src/passes/1-parser/reasonligo/.ParserMain.tag b/src/passes/1-parser/reasonligo/.ParserMain.tag new file mode 100644 index 000000000..e69de29bb diff --git a/src/passes/1-parser/reasonligo/.links b/src/passes/1-parser/reasonligo/.links new file mode 100644 index 000000000..09ca1c65f --- /dev/null +++ b/src/passes/1-parser/reasonligo/.links @@ -0,0 +1,25 @@ +$HOME/git/OCaml-build/Makefile +$HOME/git/OCaml-build/Makefile.cfg +$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli +$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml +$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli +$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml +../shared/Lexer.mli +../shared/Lexer.mll +../shared/Error.mli +../shared/EvalOpt.ml +../shared/EvalOpt.mli +../shared/FQueue.ml +../shared/FQueue.mli +../shared/LexerLog.mli +../shared/LexerLog.ml +../shared/Markup.ml +../shared/Markup.mli +../shared/Utils.mli +../shared/Utils.ml +Stubs/Simple_utils.ml +Stubs/Parser_cameligo.ml +../cameligo/AST.mli +../cameligo/AST.ml +../cameligo/ParserLog.mli +../cameligo/ParserLog.ml diff --git a/src/passes/1-parser/reasonligo/LexToken.mli b/src/passes/1-parser/reasonligo/LexToken.mli index 29ef4d2da..7c438ba02 100644 --- a/src/passes/1-parser/reasonligo/LexToken.mli +++ b/src/passes/1-parser/reasonligo/LexToken.mli @@ -56,7 +56,7 @@ type t = | VBAR of Region.t (* "|" *) | COLON of Region.t (* ":" *) | DOT of Region.t (* "." *) -| DOTDOTDOT of Region.t (* "..." *) +| ELLIPSIS of Region.t (* "..." *) (* Wildcard *) @@ -65,18 +65,18 @@ type t = (* Comparisons *) | EQ of Region.t (* "=" *) -| EQEQ of Region.t (* "=" *) -| NE of Region.t (* "!=" *) -| LT of Region.t (* "<" *) -| GT of Region.t (* ">" *) +| EQEQ of Region.t (* "=" *) +| NE of Region.t (* "!=" *) +| LT of Region.t (* "<" *) +| GT of Region.t (* ">" *) | LE of Region.t (* "=<" *) -| GE of Region.t (* ">=" *) -| ARROW of Region.t (* "=>" *) +| GE of Region.t (* ">=" *) -| BOOL_OR of Region.t (* "||" *) -| BOOL_AND of Region.t(* "&&" *) +| ARROW of Region.t (* "=>" *) -| NOT of Region.t (* ! *) +| BOOL_OR of Region.t (* "||" *) +| BOOL_AND of Region.t (* "&&" *) +| NOT of Region.t (* ! *) (* Identifiers, labels, numbers and strings *) @@ -84,8 +84,8 @@ type t = | Constr of string Region.reg | Int of (string * Z.t) Region.reg | Nat of (string * Z.t) Region.reg -| Mtz of (string * Z.t) Region.reg -| Str of string Region.reg +| Mutez of (string * Z.t) Region.reg +| String of string Region.reg | Bytes of (string * Hex.t) Region.reg (* Keywords *) diff --git a/src/passes/1-parser/reasonligo/LexToken.mll b/src/passes/1-parser/reasonligo/LexToken.mll index fc6bb4ce7..8525bfce4 100644 --- a/src/passes/1-parser/reasonligo/LexToken.mll +++ b/src/passes/1-parser/reasonligo/LexToken.mll @@ -38,7 +38,7 @@ type t = | VBAR of Region.t (* "|" *) | COLON of Region.t (* ":" *) | DOT of Region.t (* "." *) -| DOTDOTDOT of Region.t (* "..." *) +| ELLIPSIS of Region.t (* "..." *) (* Wildcard *) @@ -66,8 +66,8 @@ type t = | Constr of string Region.reg | Int of (string * Z.t) Region.reg | Nat of (string * Z.t) Region.reg -| Mtz of (string * Z.t) Region.reg -| Str of string Region.reg +| Mutez of (string * Z.t) Region.reg +| String of string Region.reg | Bytes of (string * Hex.t) Region.reg (* Keywords *) @@ -110,7 +110,7 @@ let proj_token = function | VBAR region -> region, "VBAR" | COLON region -> region, "COLON" | DOT region -> region, "DOT" - | DOTDOTDOT region -> region, "DOTDOTDOT" + | ELLIPSIS region -> region, "ELLIPSIS" | WILD region -> region, "WILD" | EQ region -> region, "EQ" | EQEQ region -> region, "EQEQ" @@ -130,10 +130,10 @@ let proj_token = function region, sprintf "Int (\"%s\", %s)" s (Z.to_string n) | Nat Region.{region; value = s,n} -> region, sprintf "Nat (\"%s\", %s)" s (Z.to_string n) - | Mtz Region.{region; value = s,n} -> + | Mutez Region.{region; value = s,n} -> region, sprintf "Mutez (\"%s\", %s)" s (Z.to_string n) - | Str Region.{region; value} -> - region, sprintf "Str %s" value + | String Region.{region; value} -> + region, sprintf "String %s" value | Bytes Region.{region; value = s,b} -> region, sprintf "Bytes (\"%s\", \"0x%s\")" @@ -169,7 +169,7 @@ let to_lexeme = function | VBAR _ -> "|" | COLON _ -> ":" | DOT _ -> "." - | DOTDOTDOT _ -> "..." + | ELLIPSIS _ -> "..." | WILD _ -> "_" | EQ _ -> "=" | EQEQ _ -> "==" @@ -183,10 +183,10 @@ let to_lexeme = function | BOOL_AND _ -> "&&" | Ident id -> id.Region.value | Constr id -> id.Region.value - | Int i - | Nat i - | Mtz i -> fst i.Region.value - | Str s -> s.Region.value + | Int i + | Nat i + | Mutez i -> fst i.Region.value + | String s -> s.Region.value | Bytes b -> fst b.Region.value | Else _ -> "else" | False _ -> "false" @@ -200,7 +200,7 @@ let to_lexeme = function | Type _ -> "type" | C_None _ -> "None" | C_Some _ -> "Some" - | EOF _ -> "" + | EOF _ -> "" let to_string token ?(offsets=true) mode = let region, val_str = proj_token token in @@ -231,11 +231,11 @@ let keywords = [ (fun reg -> Type reg); ] -(* See: http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#sec86 and +(* See: http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#sec86 and https://github.com/facebook/reason/blob/master/src/reason-parser/reason_parser.mly *) let reserved = let open SSet in - empty + empty |> add "and" |> add "as" |> add "asr" @@ -257,9 +257,9 @@ let reserved = |> add "lazy" (* |> add "lor" - see https://ligo.atlassian.net/browse/LIGO-263 *) |> add "lsl" - |> add "lsr" + |> add "lsr" (* |> add "lxor" - see https://ligo.atlassian.net/browse/LIGO-263 *) - |> add "match" + |> add "match" |> add "method" |> add "module" |> add "mutable" @@ -284,7 +284,7 @@ let reserved = let constructors = [ (fun reg -> C_None reg); - (fun reg -> C_Some reg); + (fun reg -> C_Some reg); ] let add map (key, value) = SMap.add key value map @@ -346,7 +346,7 @@ let line_comment_start lexeme = lexeme = "//" (* Smart constructors (injections) *) -let mk_string lexeme region = Str Region.{region; value=lexeme} +let mk_string lexeme region = String Region.{region; value=lexeme} let mk_bytes lexeme region = let norm = Str.(global_replace (regexp "_") "" lexeme) in @@ -376,12 +376,12 @@ let mk_mutez lexeme region = Z.of_string in if Z.equal z Z.zero && lexeme <> "0mutez" then Error Non_canonical_zero - else Ok (Mtz Region.{region; value = lexeme, z}) + else Ok (Mutez Region.{region; value = lexeme, z}) let eof region = EOF region let mk_sym lexeme region = - match lexeme with + match lexeme with "-" -> Ok (MINUS region) | "+" -> Ok (PLUS region) | "/" -> Ok (SLASH region) @@ -394,9 +394,9 @@ let mk_sym lexeme region = | ";" -> Ok (SEMI region) | "|" -> Ok (VBAR region) | ":" -> Ok (COLON region) - | "." -> Ok (DOT region) + | "." -> Ok (DOT region) | "_" -> Ok (WILD region) - | "=" -> Ok (EQ region) + | "=" -> Ok (EQ region) | "!=" -> Ok (NE region) | "<" -> Ok (LT region) | ">" -> Ok (GT region) @@ -406,10 +406,10 @@ let mk_sym lexeme region = | "&&" -> Ok (BOOL_AND region) | "(" -> Ok (LPAR region) | ")" -> Ok (RPAR region) - + (* Symbols specific to ReasonLIGO *) - | "..."-> Ok (DOTDOTDOT region) - | "=>" -> Ok (ARROW region) + | "..."-> Ok (ELLIPSIS region) + | "=>" -> Ok (ARROW region) | "==" -> Ok (EQEQ region) | "!" -> Ok (NOT region) | "++" -> Ok (CAT region) @@ -432,7 +432,7 @@ let mk_constr lexeme region = mk_constr' lexeme region lexicon (* Predicates *) let is_string = function - Str _ -> true + String _ -> true | _ -> false let is_bytes = function @@ -483,7 +483,7 @@ let is_sym = function | VBAR _ | COLON _ | DOT _ -| DOTDOTDOT _ +| ELLIPSIS _ | WILD _ | EQ _ | EQEQ _ @@ -501,4 +501,4 @@ let is_sym = function let is_eof = function EOF _ -> true | _ -> false (* END TRAILER *) -} \ No newline at end of file +} diff --git a/src/passes/1-parser/reasonligo/ParToken.mly b/src/passes/1-parser/reasonligo/ParToken.mly index a19dbec36..561f95265 100644 --- a/src/passes/1-parser/reasonligo/ParToken.mly +++ b/src/passes/1-parser/reasonligo/ParToken.mly @@ -1,76 +1,75 @@ %{ %} -(* Tokens (mirroring thise defined in module LexToken) *) +(* Tokens (mirroring those defined in module LexToken) *) (* Literals *) -%token Ident -%token Constr -%token Str -%token <(string * Z.t) Region.reg> Int -%token <(string * Z.t) Region.reg> Nat -%token <(string * Z.t) Region.reg> Mtz +%token Ident "" +%token Constr "" +%token String "" +%token <(string * Z.t) Region.reg> Int "" +%token <(string * Z.t) Region.reg> Nat "" +%token <(string * Z.t) Region.reg> Mutez "" (* Symbols *) -%token MINUS -%token PLUS -%token SLASH -%token TIMES +%token MINUS "-" +%token PLUS "+" +%token SLASH "/" +%token TIMES "*" -%token LPAR -%token RPAR -%token LBRACKET -%token RBRACKET -%token LBRACE -%token RBRACE +%token LPAR "(" +%token RPAR ")" +%token LBRACKET "[" +%token RBRACKET "]" +%token LBRACE "{" +%token RBRACE "}" -%token CAT -%token DOT -%token DOTDOTDOT +%token CAT "++" +%token DOT "." +%token ELLIPSIS "..." -%token COMMA -%token SEMI -%token COLON -%token VBAR +%token COMMA "," +%token SEMI ";" +%token COLON ":" +%token VBAR "|" -%token WILD +%token WILD "_" -%token EQ -%token EQEQ -%token NE -%token LT -%token GT -%token LE -%token GE -%token ARROW +%token EQ "=" +%token EQEQ "==" +%token NE "!=" +%token LT "<" +%token GT ">" +%token LE "<=" +%token GE ">=" +%token ARROW "=>" -%token NOT - -%token BOOL_OR -%token BOOL_AND +%token NOT "!" +%token BOOL_OR "||" +%token BOOL_AND "&&" (* Keywords *) -%token Else -%token False -%token If -%token Let -%token Switch -%token Mod -%token Or -%token True -%token Type +%token Else "else" +%token False "false" +%token If "if" +%token Let "let" +%token Switch "switch" +%token Mod "mod" +%token Or "or" +%token True "true" +%token Type "type" (* Data constructors *) -%token C_None (* "None" *) -%token C_Some (* "Some" *) +%token C_None "None" +%token C_Some "Some" (* Virtual tokens *) - + %token EOF %% diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index 8773655eb..2c66caec5 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -5,22 +5,21 @@ open Region module AST = Parser_cameligo.AST -open AST - +open! AST type 'a sequence_elements = { - s_elts : ('a, semi) Utils.nsepseq; - s_terminator : semi option + s_elts : ('a, semi) Utils.nsepseq; + s_terminator : semi option } type 'a record_elements = { - r_elts : (field_assign reg, semi) Utils.nsepseq; - r_terminator : semi option + r_elts : (field_assign reg, semi) Utils.nsepseq; + r_terminator : semi option } type 'a sequence_or_record = - PaSequence of 'a sequence_elements -| PaRecord of 'a record_elements + PaSequence of 'a sequence_elements +| PaRecord of 'a record_elements | PaSingleExpr of expr (* END HEADER *) @@ -34,7 +33,6 @@ type 'a sequence_or_record = %type contract %type interactive_expr - %nonassoc Ident %nonassoc COLON (* Solves a shift/reduce problem that happens with record and sequences. To elaborate: @@ -66,25 +64,10 @@ sep_or_term_list(item,sep): (* Compound constructs *) par(X): - LPAR X RPAR { + "(" X ")" { let region = cover $1 $3 - and value = { - lpar = $1; - inside = $2; - rpar = $3} - in {region; value} - } - -braces(X): - LBRACE X RBRACE { - let region = cover $1 $3 - and value = { - lpar = $1; - inside = $2; - rpar = $3} - in {region; value} - } - + and value = {lpar=$1; inside=$2; rpar=$3} + in {region; value} } (* Sequences @@ -119,258 +102,182 @@ nsepseq(item,sep): item { $1, [] } | item sep nsepseq(item,sep) { let h,t = $3 in $1, ($2,h)::t } -(* Possibly empy separated sequence of items *) - -sepseq(item,sep): - (**) { None } -| nsepseq(item,sep) { Some $1 } - (* Helpers *) -%inline type_name : Ident { $1 } -%inline field_name : Ident { $1 } -%inline module_name : Constr { $1 } -%inline struct_name : Ident { $1 } +%inline type_name : "" { $1 } +%inline field_name : "" { $1 } +%inline struct_name : "" { $1 } +%inline module_name : "" { $1 } (* Non-empty comma-separated values (at least two values) *) tuple(item): - item COMMA nsepseq(item,COMMA) { - let h,t = $3 in $1,($2,h)::t - } + item "," nsepseq(item,",") { let h,t = $3 in $1,($2,h)::t } (* Possibly empty semicolon-separated values between brackets *) list(item): - LBRACKET sep_or_term_list(item, COMMA) RBRACKET { - let elements, terminator = $2 in - { value = - { - compound = Brackets ($1,$3); - elements = Some elements; - terminator; - }; - region = cover $1 $3 - } - } -| LBRACKET RBRACKET { - let value = { - compound = Brackets ($1,$2); - elements = None; - terminator = None} in - let region = cover $1 $2 - in {value; region} - } + "[" sep_or_term_list(item,";")? "]" { + let compound = Brackets ($1,$3) + and region = cover $1 $3 in + let elements, terminator = + match $2 with + None -> None, None + | Some (elements, terminator) -> + Some elements, terminator in + let value = {compound; elements; terminator} + in {region; value} } (* Main *) contract: - declarations EOF { - {decl = $1; eof=$2} } + declarations EOF { {decl=$1; eof=$2} } declarations: declaration { $1,[] : AST.declaration Utils.nseq } | declaration declarations { Utils.nseq_cons $1 $2 } declaration: -| type_decl SEMI { TypeDecl $1 } -| let_declaration SEMI { Let $1 } +| type_decl ";" { TypeDecl $1 } +| let_declaration ";" { Let $1 } (* Type declarations *) type_decl: - Type type_name EQ type_expr { + "type" type_name "=" type_expr { let region = cover $1 (type_expr_to_region $4) in let value = { kwd_type = $1; name = $2; eq = $3; - type_expr = $4; - } - in {region; value} - } + type_expr = $4} + in {region; value} } type_expr: - cartesian { $1 } -| sum_type { TSum $1 } -| record_type { TRecord $1 } + cartesian | sum_type | record_type { $1 } cartesian: - fun_type COMMA nsepseq(fun_type,COMMA) { + fun_type { $1 } +| fun_type "," nsepseq(fun_type,",") { let value = Utils.nsepseq_cons $1 $2 $3 in let region = nsepseq_to_region type_expr_to_region value - in TProd {region; value} - } -| fun_type { ($1 : type_expr) } + in TProd {region; value} } fun_type: - core_type { - $1 - } -| core_type ARROW fun_type { - let region = cover (type_expr_to_region $1) (type_expr_to_region $3) in - TFun {region; value = ($1, $2, $3)} -} + core_type { $1 } +| core_type "=>" fun_type { + let start = type_expr_to_region $1 + and stop = type_expr_to_region $3 in + let region = cover start stop in + TFun {region; value=$1,$2,$3} } core_type: - type_name { - TVar $1 - } -| module_name DOT type_name { + type_name { TVar $1 } +| par(type_expr) { TPar $1 } +| module_name "." type_name { let module_name = $1.value in let type_name = $3.value in let value = module_name ^ "." ^ type_name in let region = cover $1.region $3.region - in - TVar {region; value} + in TVar {region; value} } -| type_constr LPAR nsepseq(core_type, COMMA) RPAR { - let arg_val = $3 in - let constr = $1 in - let start = $1.region in - let stop = $4 in - let region = cover start stop in - let lpar, rpar = $2, $4 in - TApp Region.{value = constr, { - value = { - lpar; - rpar; - inside = arg_val - }; - region = cover lpar rpar; - }; region} - } -| par (type_expr) { - TPar $1 -} - -type_constr: - type_name { $1 } +| type_name par(nsepseq(core_type,",") { $1 }) { + let constr, arg = $1, $2 in + let start = constr.region + and stop = arg.region in + let region = cover start stop in + TApp {region; value = constr,arg} } sum_type: - VBAR nsepseq(variant,VBAR) { + "|" nsepseq(variant,"|") { let region = nsepseq_to_region (fun x -> x.region) $2 - in {region; value = $2} - } + in TSum {region; value=$2} } variant: - Constr LPAR cartesian RPAR { + "" { {$1 with value={constr=$1; arg=None}} } +| "" "(" cartesian ")" { let region = cover $1.region $4 - and value = {constr = $1; arg = Some ($2, $3)} - in {region; value} - } -| Constr { - {region=$1.region; value= {constr=$1; arg=None}} } + and value = {constr=$1; arg = Some ($2,$3)} + in {region; value} } record_type: - LBRACE sep_or_term_list(field_decl,COMMA) RBRACE { + "{" sep_or_term_list(field_decl,",") "}" { let ne_elements, terminator = $2 in let region = cover $1 $3 - and value = { - compound = Braces ($1,$3); - ne_elements; - terminator; - } - in {region; value} - } + and value = {compound = Braces ($1,$3); ne_elements; terminator} + in TRecord {region; value} } type_expr_field: - core_type { $1 } -| sum_type { TSum $1 } -| record_type { TRecord $1 } + core_type | sum_type | record_type { $1 } field_decl: field_name { - let value = {field_name = $1; colon = Region.ghost; field_type = TVar $1} - in {region = $1.region; value} + let value = { + field_name = $1; + colon = Region.ghost; + field_type = TVar $1} + in {$1 with value} } - | field_name COLON type_expr_field { +| field_name ":" type_expr_field { let stop = type_expr_to_region $3 in let region = cover $1.region stop - and value = {field_name = $1; colon = $2; field_type = $3} - in {region; value} - } + and value = {field_name=$1; colon=$2; field_type=$3} + in {region; value} } (* Top-level non-recursive definitions *) let_declaration: - Let let_binding { + "let" let_binding { let kwd_let = $1 in - let binding, (region: Region.region) = $2 in - {value = kwd_let, binding; region} - } + let binding = $2 in + let value = kwd_let, binding in + let stop = expr_to_region binding.let_rhs in + let region = cover $1 stop + in {region; value} } es6_func: - ARROW expr { - $1, $2 - } + "=>" expr { $1,$2 } let_binding: - | Ident type_annotation? EQ expr { - let pattern = PVar $1 in - let start = pattern_to_region pattern in - let stop = expr_to_region $4 in - let region = cover start stop in - ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) - } -| tuple(sub_irrefutable) type_annotation? EQ expr { - let h, t = $1 in - let start = pattern_to_region h in - let stop = last (fun (region, _) -> region) t in - let region = cover start stop in - let pattern = PTuple { value = $1; region } in - let start = region in - let stop = expr_to_region $4 in - let region = cover start stop in - ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) -} -| WILD type_annotation? EQ expr { - let pattern = PWild $1 in - let start = pattern_to_region pattern in - let stop = expr_to_region $4 in - let region = cover start stop in - ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) + "" type_annotation? "=" expr { + {binders = PVar $1,[]; lhs_type=$2; eq=$3; let_rhs=$4} } -| unit type_annotation? EQ expr { - let pattern = PUnit $1 in - let start = pattern_to_region pattern in - let stop = expr_to_region $4 in - let region = cover start stop in - ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) +| "_" type_annotation? "=" expr { + {binders = PWild $1,[]; lhs_type=$2; eq=$3; let_rhs=$4} } -| record_pattern type_annotation? EQ expr { - let pattern = PRecord $1 in - let start = pattern_to_region pattern in - let stop = expr_to_region $4 in - let region = cover start stop in - ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) +| unit type_annotation? "=" expr { + {binders = PUnit $1,[]; lhs_type=$2; eq=$3; let_rhs=$4} } -| par(closed_irrefutable) type_annotation? EQ expr { - let pattern = PPar $1 in - let start = pattern_to_region pattern in - let stop = expr_to_region $4 in - let region = cover start stop in - ({binders = pattern, []; lhs_type=$2; eq=$3; let_rhs=$4}, region) +| record_pattern type_annotation? "=" expr { + {binders = PRecord $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } +| par(closed_irrefutable) type_annotation? "=" expr { + {binders = PPar $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } +| tuple(sub_irrefutable) type_annotation? "=" expr { + let hd, tl = $1 in + let start = pattern_to_region hd in + let stop = last fst tl in + let region = cover start stop in + let binders = PTuple {value=$1; region}, [] in + {binders; lhs_type=$2; eq=$3; let_rhs=$4} } type_annotation: - COLON type_expr { $1,$2 } + ":" type_expr { $1,$2 } (* Patterns *) irrefutable: - tuple(sub_irrefutable) { - let h, t = $1 in - let start = pattern_to_region h in - let stop = last (fun (region, _) -> region) t in + sub_irrefutable { $1 } +| tuple(sub_irrefutable) { + let hd, tl = $1 in + let start = pattern_to_region hd in + let stop = last fst tl in let region = cover start stop in - PTuple { value = $1; region } - } -| sub_irrefutable { $1 } + PTuple {region; value=$1} } sub_irrefutable: - Ident { PVar $1 } -| WILD { PWild $1 } + "" { PVar $1 } +| "_" { PWild $1 } | unit { PUnit $1 } | record_pattern { PRecord $1 } | par(closed_irrefutable) { PPar $1 } @@ -381,181 +288,147 @@ closed_irrefutable: | typed_pattern { PTyped $1 } typed_pattern: - irrefutable COLON type_expr { - let start = pattern_to_region $1 in - let stop = type_expr_to_region $3 in + irrefutable ":" type_expr { + let start = pattern_to_region $1 in + let stop = type_expr_to_region $3 in let region = cover start stop in - { - value = { - pattern = $1; - colon = $2; - type_expr = $3 - }; - region - } - } + let value = { + pattern = $1; + colon = $2; + type_expr = $3} + in {region; value} } pattern: - LBRACKET sub_pattern COMMA DOTDOTDOT sub_pattern RBRACKET { - let start = pattern_to_region $2 in - let stop = pattern_to_region $5 in + "[" sub_pattern "," "..." sub_pattern "]" { + let start = pattern_to_region $2 in + let stop = pattern_to_region $5 in let region = cover start stop in - let val_ = {value = $2, $3, $5; region} in - PList (PCons val_) + let cons = {value=$2,$3,$5; region} + in PList (PCons cons) } | tuple(sub_pattern) { - let h, t = $1 in - let start = pattern_to_region h in - let stop = last (fun (region, _) -> region) t in - let region = cover start stop in - PTuple { value = $1; region } + let hd, tl = $1 in + let start = pattern_to_region hd in + let stop = last fst tl in + let region = cover start stop + in PTuple {value=$1; region} } -| core_pattern { $1 } +| core_pattern { $1 } sub_pattern: - par(sub_pattern) { PPar $1 } + par(sub_pattern) { PPar $1 } | core_pattern { $1 } core_pattern: - Ident { PVar $1 } -| WILD { PWild $1 } + "" { PVar $1 } +| "_" { PWild $1 } | unit { PUnit $1 } -| Int { PInt $1 } -| True { PTrue $1 } -| False { PFalse $1 } -| Str { PString $1 } +| "" { PInt $1 } +| "true" { PTrue $1 } +| "false" { PFalse $1 } +| "" { PString $1 } | par(ptuple) { PPar $1 } -| list(sub_pattern) { PList (PListComp $1) } +| list(sub_pattern) { PList (PListComp $1) } | constr_pattern { PConstr $1 } | record_pattern { PRecord $1 } record_pattern: - LBRACE sep_or_term_list(field_pattern,COMMA) RBRACE { + "{" sep_or_term_list(field_pattern,",") "}" { let ne_elements, terminator = $2 in let region = cover $1 $3 in let value = { compound = Braces ($1,$3); ne_elements; - terminator; - } - in - {region; value} - } + terminator} + in {region; value} } field_pattern: - field_name EQ sub_pattern { - let start = $1.region in - let stop = pattern_to_region $3 in + field_name "=" sub_pattern { + let start = $1.region in + let stop = pattern_to_region $3 in let region = cover start stop in - { value = {field_name=$1; eq=$2; pattern=$3}; region } - } + let value = {field_name=$1; eq=$2; pattern=$3} + in {region; value} } constr_pattern: - C_None { PNone $1 } -| C_Some sub_pattern { + "None" { PNone $1 } +| "Some" sub_pattern { let stop = pattern_to_region $2 in let region = cover $1 stop - and value = $1, $2 - in PSomeApp {value; region} + and value = $1, $2 in + PSomeApp {region; value} } -| Constr { - PConstrApp { value = $1, None; region = $1.region } } -| Constr sub_pattern { - let region = cover $1.region (pattern_to_region $2) in - PConstrApp { value = $1, Some $2; region } +| "" sub_pattern { + let region = cover $1.region (pattern_to_region $2) + in PConstrApp {region; value = $1, Some $2} } - +| "" { PConstrApp {$1 with value=$1,None} } ptuple: tuple(sub_pattern) { - let h, t = $1 in - let start = pattern_to_region h in - let stop = last (fun (region, _) -> region) t in - let region = cover start stop in - PTuple { value = $1; region } - } + let hd, tl = $1 in + let start = pattern_to_region hd in + let stop = last fst tl in + let region = cover start stop + in PTuple {value=$1; region} } unit: - LPAR RPAR { - let the_unit = ghost, ghost in - let region = cover $1 $2 in - { value = the_unit; region } - } + "(" ")" { {region = cover $1 $2; value = ghost, ghost} } (* Expressions *) interactive_expr: - expr EOF { $1 } + expr EOF { $1 } expr: - base_cond__open(expr) { $1 } -| switch_expr(base_cond) { ECase $1 } + base_cond__open(expr) | switch_expr(base_cond) { $1 } base_cond__open(x): - base_expr(x) -| conditional(x) { $1 } + base_expr(x) | conditional(x) { $1 } base_cond: - base_cond__open(base_cond) { $1 } + base_cond__open(base_cond) { $1 } type_expr_simple_args: - LPAR nsepseq(type_expr_simple, COMMA) RPAR { - $1, $2, $3 - } + "(" nsepseq(type_expr_simple, ",") ")" { $1, $2, $3 } type_expr_simple: core_expr_2 type_expr_simple_args? { let args = $2 in - let constr = match $1 with - | EVar i -> i - | EProj {value = {struct_name; field_path; _}; region} -> - let path = - (Utils.nsepseq_foldl - (fun a e -> - match e with - | FieldName v -> a ^ "." ^ v.value - | Component {value = c, _; _} -> a ^ "." ^ c - ) - struct_name.value - field_path - ) - in - {value = path; region } - | EArith (Mutez {value = s, _; region }) - | EArith (Int {value = s, _; region }) - | EArith (Nat {value = s, _; region }) -> { value = s; region } - | EString (String {value = s; region}) -> { value = s; region } - | ELogic (BoolExpr (True t)) -> { value = "true"; region = t } - | ELogic (BoolExpr (False f)) -> { value = "false"; region = f } - | _ -> failwith "Not supported" - in - match args with - Some (lpar, args, rpar) -> ( - let start = expr_to_region $1 in - let stop = rpar in - let region = cover start stop in - TApp { - value = constr, { - value = { - inside = args; - lpar; - rpar - }; - region}; - region} - ) - | None -> TVar constr + let constr = + match $1 with + EVar i -> i + | EProj {value={struct_name; field_path; _}; region} -> + let app a = function + FieldName v -> a ^ "." ^ v.value + | Component {value = c, _; _} -> a ^ "." ^ c in + let path = + Utils.nsepseq_foldl app struct_name.value field_path + in {value=path; region} + | EArith Mutez r | EArith Int r | EArith Nat r -> + {r with value = fst r.value} + | EString String s -> s + | ELogic BoolExpr (True t) -> {value="true"; region=t} + | ELogic BoolExpr (False f) -> {value="false"; region=f} + | _ -> failwith "Not supported" + in match args with + Some (lpar, args, rpar) -> + let region = cover (expr_to_region $1) rpar + and value = {inside=args; lpar; rpar} in + let value = constr, {region; value} + in TApp {region; value} + | None -> TVar constr } - | LPAR nsepseq(type_expr_simple, COMMA) RPAR { - TProd {value = $2; region = cover $1 $3} +| "(" nsepseq(type_expr_simple, ",") ")" { + TProd {value=$2; region = cover $1 $3} + } +| "(" type_expr_simple "=>" type_expr_simple ")" { + TFun {value=$2,$3,$4; region = cover $1 $5} } - | LPAR type_expr_simple ARROW type_expr_simple RPAR { - TFun {value = $2, $3, $4; region = cover $1 $5} - } type_annotation_simple: - COLON type_expr_simple { $2 } + ":" type_expr_simple { $1,$2 } fun_expr: disj_expr_level es6_func { @@ -566,12 +439,9 @@ fun_expr: let region = cover start stop in let rec arg_to_pattern = (function | EVar val_ -> PVar val_ - | EAnnot {value = (EVar v, typ); region} -> - PTyped {value = { - pattern = PVar v; - colon = Region.ghost; - type_expr = typ; - } ; region} + | EAnnot {value = {inside = EVar v, colon, typ; _}; region} -> + let value = {pattern = PVar v; colon; type_expr = typ} + in PTyped {region; value} | EPar {value = {inside; lpar; rpar}; region} -> PPar {value = {inside = arg_to_pattern inside; lpar; rpar}; region} | EUnit u -> PUnit u @@ -579,19 +449,30 @@ fun_expr: ) in let fun_args_to_pattern = (function - | EAnnot {value = (ETuple {value = fun_args; _}, _); _} -> (* ((foo:x, bar) : type) *) - let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in - (arg_to_pattern (fst fun_args), bindings) - | EAnnot {value = (EPar {value = {inside = fun_arg ; _}; _}, _); _} -> (* ((foo:x, bar) : type) *) + EAnnot { + value = { + inside = ETuple {value=fun_args; _}, _, _; + _}; + _} -> + (* ((foo:x, bar) : type) *) + let bindings = + List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) + in arg_to_pattern (fst fun_args), bindings + | EAnnot { + value = { + inside = EPar {value = {inside=fun_arg; _}; _}, _, _; + _}; + _} -> + (* ((foo:x, bar) : type) *) (arg_to_pattern fun_arg, []) | EPar {value = {inside = fun_arg; _ }; _} -> - (arg_to_pattern fun_arg, []) - | EAnnot e -> (arg_to_pattern (EAnnot e), []) + arg_to_pattern fun_arg, [] + | EAnnot e -> arg_to_pattern (EAnnot e), [] | ETuple {value = fun_args; _} -> let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in (arg_to_pattern (fst fun_args), bindings) | EUnit e -> - (arg_to_pattern (EUnit e), []) + arg_to_pattern (EUnit e), [] | _ -> failwith "Not supported" ) in @@ -607,24 +488,20 @@ fun_expr: } base_expr(right_expr): - let_expr(right_expr) -| disj_expr_level { $1 } -| fun_expr { $1 } + let_expr(right_expr) | disj_expr_level | fun_expr { $1 } conditional(right_expr): - if_then_else(right_expr) - | if_then(right_expr) { ECond $1 } + if_then_else(right_expr) | if_then(right_expr) { $1 } parenthesized_expr: - braces (expr) { $1.value.inside } - | par (expr) { $1.value.inside } + "{" expr "}" | "(" expr ")" { $2 } if_then(right_expr): - If parenthesized_expr LBRACE closed_if RBRACE { + "if" parenthesized_expr "{" closed_if "}" { let the_unit = ghost, ghost in let ifnot = EUnit {region=ghost; value=the_unit} in let region = cover $1 $5 in - { + ECond { value = { kwd_if = $1; test = $2; @@ -638,9 +515,10 @@ if_then(right_expr): } if_then_else(right_expr): - If parenthesized_expr LBRACE closed_if SEMI RBRACE Else LBRACE right_expr SEMI RBRACE { + "if" parenthesized_expr "{" closed_if ";" "}" + "else" "{" right_expr ";" "}" { let region = cover $1 $11 in - { + ECond { value = { kwd_if = $1; test = $2; @@ -654,424 +532,336 @@ if_then_else(right_expr): } base_if_then_else__open(x): - base_expr(x) { $1 } -| if_then_else(x) { ECond $1 } + base_expr(x) | if_then_else(x) { $1 } base_if_then_else: - base_if_then_else__open(base_if_then_else) { $1 } + base_if_then_else__open(base_if_then_else) { $1 } closed_if: - base_if_then_else__open(closed_if) { $1 } -| switch_expr(base_if_then_else) { ECase $1 } + base_if_then_else__open(closed_if) +| switch_expr(base_if_then_else) { $1 } switch_expr(right_expr): - Switch switch_expr_ LBRACE cases(right_expr) RBRACE { - let cases = $4 in + "switch" switch_expr_ "{" cases(right_expr) "}" { let start = $1 in let stop = $5 in - let region = cover start stop in - { value = { + let cases = { + value = $4; + region = nsepseq_to_region (fun x -> x.region) $4} in + let region = cover start stop + and value = { kwd_match = $1; expr = $2; lead_vbar = None; kwd_with = Region.ghost; - cases = { - value = cases; - region = nsepseq_to_region (fun {region; _} -> region) $4 - }; - }; - region - } - } + cases} + in ECase {region; value} } switch_expr_: - | par(expr) { - $1.value.inside - } - | core_expr_2 { - $1 - } + par(expr) { $1.value.inside } +| core_expr_2 { $1 } cases(right_expr): nseq(case_clause(right_expr)) { - let (hd, tl) = $1 in - hd, (List.map (fun f -> expr_to_region f.value.rhs, f) tl) + let hd, tl = $1 in + hd, List.map (fun f -> expr_to_region f.value.rhs, f) tl } case_clause(right_expr): - VBAR pattern ARROW right_expr SEMI? { - let region = cover (pattern_to_region $2) (expr_to_region $4) in - {value = - { - pattern = $2; - arrow = $3; - rhs=$4 - }; - region - } - } + "|" pattern "=>" right_expr ";"? { + let start = pattern_to_region $2 + and stop = expr_to_region $4 in + let region = cover start stop + and value = {pattern=$2; arrow=$3; rhs=$4} + in {region; value} } let_expr(right_expr): - Let let_binding SEMI right_expr { + "let" let_binding ";" right_expr { let kwd_let = $1 in - let (binding: let_binding), _ = $2 in - let kwd_in = $3 in - let body = $4 in - let stop = expr_to_region $4 in - let region = cover $1 stop in - let let_in = {kwd_let; binding; kwd_in; body} - in ELetIn {region; value=let_in} } + let binding = $2 in + let kwd_in = $3 in + let body = $4 in + let stop = expr_to_region $4 in + let region = cover $1 stop + and value = {kwd_let; binding; kwd_in; body} + in ELetIn {region; value} } disj_expr_level: - disj_expr { ELogic (BoolExpr (Or $1)) } -| conj_expr_level { $1 } + disj_expr +| conj_expr_level { $1 } | par(tuple(disj_expr_level)) type_annotation_simple? { let region = $1.region in let tuple = ETuple {value=$1.value.inside; region} in - let region = match $2 with - | Some s -> cover $1.region (type_expr_to_region s) - | None -> region - in + let region = + match $2 with + Some (_,s) -> cover $1.region (type_expr_to_region s) + | None -> region in match $2 with - | Some typ -> EAnnot({value = tuple, typ; region}) - | None -> tuple - } + Some (colon, typ) -> + let value = {$1.value with inside = tuple,colon,typ} + in EAnnot {region; value} + | None -> tuple } bin_op(arg1,op,arg2): - arg1 op arg2 { + arg1 op arg2 { let start = expr_to_region $1 in let stop = expr_to_region $3 in - let region = cover start stop in - { value = { arg1=$1; op=$2; arg2=$3}; region } - } + let region = cover start stop + and value = { arg1=$1; op=$2; arg2=$3} + in {region; value} } disj_expr: - bin_op(disj_expr_level, BOOL_OR, conj_expr_level) -| bin_op(disj_expr_level, Or, conj_expr_level) { $1 } + bin_op(disj_expr_level, "||", conj_expr_level) +| bin_op(disj_expr_level, "or", conj_expr_level) { + ELogic (BoolExpr (Or $1)) } conj_expr_level: - conj_expr { ELogic (BoolExpr (And $1)) } -| comp_expr_level { $1 } + conj_expr +| comp_expr_level { $1 } conj_expr: - bin_op(conj_expr_level, BOOL_AND, comp_expr_level) { $1 } + bin_op(conj_expr_level, "&&", comp_expr_level) { + ELogic (BoolExpr (And $1)) } comp_expr_level: - lt_expr { ELogic (CompExpr (Lt $1)) } -| le_expr { ELogic (CompExpr (Leq $1)) } -| gt_expr { ELogic (CompExpr (Gt $1)) } -| ge_expr { ELogic (CompExpr (Geq $1)) } -| eq_expr { ELogic (CompExpr (Equal $1)) } -| ne_expr { ELogic (CompExpr (Neq $1)) } -| cat_expr_level { $1 } - -lt_expr: - bin_op(comp_expr_level, LT, cat_expr_level) { $1 } - -le_expr: - bin_op(comp_expr_level, LE, cat_expr_level) { $1 } - -gt_expr: - bin_op(comp_expr_level, GT, cat_expr_level) { $1 } - -ge_expr: - bin_op(comp_expr_level, GE, cat_expr_level) { $1 } - -eq_expr: - bin_op(comp_expr_level, EQEQ, cat_expr_level) { $1 } - -ne_expr: - bin_op(comp_expr_level, NE, cat_expr_level) { $1 } + bin_op(comp_expr_level, "<", cat_expr_level) { + ELogic (CompExpr (Lt $1)) } +| bin_op(comp_expr_level, "<=", cat_expr_level) { + ELogic (CompExpr (Leq $1)) } +| bin_op(comp_expr_level, ">", cat_expr_level) { + ELogic (CompExpr (Gt $1)) } +| bin_op(comp_expr_level, ">=", cat_expr_level) { + ELogic (CompExpr (Geq $1)) } +| bin_op(comp_expr_level, "==", cat_expr_level) { + ELogic (CompExpr (Equal $1)) } +| bin_op(comp_expr_level, "!=", cat_expr_level) { + ELogic (CompExpr (Neq $1)) } +| cat_expr_level { $1 } cat_expr_level: - cat_expr { EString (Cat $1) } + bin_op(add_expr_level, "++", add_expr_level) { EString (Cat $1) } | add_expr_level { $1 } -cat_expr: - bin_op(add_expr_level, CAT, add_expr_level) { $1 } - add_expr_level: - plus_expr { EArith (Add $1) } -| minus_expr { EArith (Sub $1) } + bin_op(add_expr_level, "+", mult_expr_level) { EArith (Add $1) } +| bin_op(add_expr_level, "-", mult_expr_level) { EArith (Sub $1) } | mult_expr_level { $1 } -plus_expr: - bin_op(add_expr_level, PLUS, mult_expr_level) { $1 } - -minus_expr: - bin_op(add_expr_level, MINUS, mult_expr_level) { $1 } - mult_expr_level: - times_expr { EArith (Mult $1) } -| div_expr { EArith (Div $1) } -| mod_expr { EArith (Mod $1) } -| unary_expr_level { $1 } - -times_expr: - bin_op(mult_expr_level, TIMES, unary_expr_level) { $1 } - -div_expr: - bin_op(mult_expr_level, SLASH, unary_expr_level) { $1 } - -mod_expr: - bin_op(mult_expr_level, Mod, unary_expr_level) { $1 } + bin_op(mult_expr_level, "*", unary_expr_level) { EArith (Mult $1) } +| bin_op(mult_expr_level, "/", unary_expr_level) { EArith (Div $1) } +| bin_op(mult_expr_level, "mod", unary_expr_level) { EArith (Mod $1) } +| unary_expr_level { $1 } unary_expr_level: - MINUS call_expr_level { - let start = $1 in - let end_ = expr_to_region $2 in - let region = cover start end_ - and value = {op = $1; arg = $2} + call_expr_level { $1 } +| "-" call_expr_level { + let start = $1 in + let stop = expr_to_region $2 in + let region = cover start stop + and value = {op=$1; arg=$2} in EArith (Neg {region; value}) -} -| NOT call_expr_level { - let start = $1 in - let end_ = expr_to_region $2 in - let region = cover start end_ - and value = {op = $1; arg = $2} in - ELogic (BoolExpr (Not ({region; value}))) -} -| call_expr_level { - $1 } +| "!" call_expr_level { + let start = $1 in + let stop = expr_to_region $2 in + let region = cover start stop + and value = {op=$1; arg=$2} in + ELogic (BoolExpr (Not {region; value})) } call_expr_level: call_expr_level_in type_annotation_simple? { - let region = match $2 with - | Some s -> cover (expr_to_region $1) (type_expr_to_region s) - | None -> expr_to_region $1 - in + let region = + match $2 with + Some (_, s) -> + cover (expr_to_region $1) (type_expr_to_region s) + | None -> expr_to_region $1 in match $2 with - | Some t -> - EAnnot { value = $1, t; region } - | None -> $1 - } + Some (colon, t) -> + let value = { + lpar=Region.ghost; + inside=$1,colon,t; + rpar=Region.ghost} + in EAnnot {region; value} + | None -> $1 } call_expr_level_in: - call_expr { $1 } -| constr_expr { $1 } -| core_expr { $1 } + call_expr | constr_expr | core_expr { $1 } constr_expr: - C_None { - EConstr (ENone $1) + "None" { + EConstr (ENone $1) } - | C_Some core_expr { +| "Some" core_expr { let region = cover $1 (expr_to_region $2) - in EConstr (ESomeApp {value = $1,$2; region}) - } - | Constr core_expr? { - let start = $1.region in - let stop = match $2 with - | Some c -> expr_to_region c - | None -> start - in - let region = cover start stop in - EConstr (EConstrApp { value = $1,$2; region}) + in EConstr (ESomeApp {value=$1,$2; region}) } +| "" core_expr { + let region = cover $1.region (expr_to_region $2) in + EConstr (EConstrApp {region; value=$1, Some $2}) + } +| "" { + EConstr (EConstrApp {$1 with value=$1, None}) } call_expr: - core_expr LPAR nsepseq(expr, COMMA) RPAR { - let start = expr_to_region $1 in - let stop = $4 in + core_expr "(" nsepseq(expr, ",") ")" { + let start = expr_to_region $1 in + let stop = $4 in let region = cover start stop in let hd, tl = $3 in - let tl = (List.map (fun (_, a) -> a) tl) in - ECall { value = $1, (hd, tl); region } - } - | core_expr unit { - let start = expr_to_region $1 in - let stop = $2.region in - let region = cover start stop in - ECall { value = $1, (EUnit $2, []); region } + let tl = List.map snd tl in + ECall {region; value = $1,(hd,tl)} } +| core_expr unit { + let start = expr_to_region $1 in + let stop = $2.region in + let region = cover start stop + and value = $1, (EUnit $2, []) + in ECall {region; value} } + +common_expr: + "" { EArith (Int $1) } +| "" { EArith (Mutez $1) } +| "" { EArith (Nat $1) } +| "" | module_field { EVar $1 } +| projection { EProj $1 } +| "" { EString (String $1) } +| unit { EUnit $1 } +| "false" { ELogic (BoolExpr (False $1)) } +| "true" { ELogic (BoolExpr (True $1)) } core_expr_2: - Int { EArith (Int $1) } -| Mtz { EArith (Mutez $1) } -| Nat { EArith (Nat $1) } -| Ident | module_field { EVar $1 } -| projection { EProj $1 } -| Str { EString (String $1) } -| unit { EUnit $1 } -| False { ELogic (BoolExpr (False $1)) } -| True { ELogic (BoolExpr (True $1)) } -| list(expr) { EList (EListComp $1) } + common_expr { $1 } +| list(expr) { EList (EListComp $1) } list_or_spread: - LBRACKET expr COMMA sep_or_term_list(expr, COMMA) RBRACKET { - let (e, terminator) = $4 in - let e = Utils.nsepseq_cons $2 $3 e in - EList (EListComp ({ value = - { - compound = Brackets ($1,$5); - elements = Some e; - terminator; - }; - region = cover $1 $5 - })) + "[" expr "," sep_or_term_list(expr, ",") "]" { + let elts, terminator = $4 in + let elts = Utils.nsepseq_cons $2 $3 elts in + let value = { + compound = Brackets ($1,$5); + elements = Some elts; + terminator} + and region = cover $1 $5 in + EList (EListComp {region; value}) } - | LBRACKET expr COMMA DOTDOTDOT expr RBRACKET { - let region = cover $1 $6 in - EList (ECons {value={arg1=$2; op=$4; arg2=$5}; region}) - } - | LBRACKET expr RBRACKET { - EList (EListComp ({ value = - { - compound = Brackets ($1,$3); - elements = Some ($2, []); - terminator = None; - }; - region = cover $1 $3 - })) - } - | LBRACKET RBRACKET { - let value = { - compound = Brackets ($1,$2); - elements = None; - terminator = None} in - let region = cover $1 $2 - in EList (EListComp ( {value; region})) +| "[" expr "," "..." expr "]" { + let region = cover $1 $6 + and value = {arg1=$2; op=$4; arg2=$5} + in EList (ECons {region; value}) } +| "[" expr? "]" { + let compound = Brackets ($1,$3) + and elements = + match $2 with + None -> None + | Some element -> Some (element, []) in + let value = {compound; elements; terminator=None} + and region = cover $1 $3 in + EList (EListComp {region; value}) } core_expr: - Int { EArith (Int $1) } -| Mtz { EArith (Mutez $1) } -| Nat { EArith (Nat $1) } -| Ident | module_field { EVar $1 } -| projection { EProj $1 } -| Str { EString (String $1) } -| unit { EUnit $1 } -| False { ELogic (BoolExpr (False $1)) } -| True { ELogic (BoolExpr (True $1)) } -| list_or_spread { $1 } -| par(expr) { EPar $1 } -| sequence_or_record { $1 } + common_expr +| list_or_spread +| sequence_or_record { $1 } +| par(expr) { EPar $1 } module_field: - module_name DOT field_name { - let region = cover $1.region $3.region in - { value = $1.value ^ "." ^ $3.value; region } - } + module_name "." field_name { + let region = cover $1.region $3.region + and value = $1.value ^ "." ^ $3.value + in {region; value} } selection: - | LBRACKET Int RBRACKET selection { + "[" "" "]" selection { let r, (h, t) = $4 in - let result:((selection, dot) Utils.nsepseq) = (Component $2), (Region.ghost, h) :: t in - r, result + let result: (selection, dot) Utils.nsepseq = + Component $2, (Region.ghost, h) :: t + in r, result } - | DOT field_name selection { +| "." field_name selection { let r, (h, t) = $3 in - let result:((selection, dot) Utils.nsepseq) = (FieldName $2), ($1, h) :: t in - r, result + let result: (selection, dot) Utils.nsepseq = + FieldName $2, ($1, h) :: t + in r, result } - | DOT field_name { - $1, ((FieldName $2), []) - } - | LBRACKET Int RBRACKET { - Region.ghost, ((Component $2), []) +| "." field_name { + $1, (FieldName $2, []) } +| "[" "" "]" { + Region.ghost, (Component $2, []) } projection: struct_name selection { - let start = $1.region in - let stop = nsepseq_to_region (function - | FieldName f -> f.region - | Component c -> c.region) (snd $2) - in - let region = cover start stop in - { value = - { - struct_name = $1; - selector = fst $2; - field_path = snd $2 - }; - region - } + let start = $1.region in + let stop = nsepseq_to_region selection_to_region (snd $2) in + let region = cover start stop + and value = { + struct_name = $1; + selector = fst $2; + field_path = snd $2} + in {region; value} } -| module_name DOT field_name selection { +| module_name "." field_name selection { let module_name = $1 in - let field_name = $3 in - let value = module_name.value ^ "." ^ field_name.value in + let field_name = $3 in + let value = module_name.value ^ "." ^ field_name.value in let struct_name = {$1 with value} in - let start = $1.region in - let stop = nsepseq_to_region (function - | FieldName f -> f.region - | Component c -> c.region) (snd $4) - in - let region = cover start stop in - { value = - { - struct_name; - selector = fst $4; - field_path = snd $4 - }; - region - } - } + let start = $1.region in + let stop = nsepseq_to_region selection_to_region (snd $4) in + let region = cover start stop + and value = { + struct_name; + selector = fst $4; + field_path = snd $4} + in {region; value} } sequence_or_record_in: - expr SEMI sep_or_term_list(expr,SEMI) { - let (e, _region) = $3 in - let e = Utils.nsepseq_cons $1 $2 e in - PaSequence { s_elts = e; s_terminator = None} + expr ";" sep_or_term_list(expr,";") { + let elts, _region = $3 in + let s_elts = Utils.nsepseq_cons $1 $2 elts + in PaSequence {s_elts; s_terminator=None} } -| field_assignment COMMA sep_or_term_list(field_assignment,COMMA) { - let (e, _region) = $3 in - let e = Utils.nsepseq_cons $1 $2 e in - PaRecord { r_elts = e; r_terminator = None} - } - | expr SEMI? { - PaSingleExpr $1 +| field_assignment "," sep_or_term_list(field_assignment,",") { + let elts, _region = $3 in + let r_elts = Utils.nsepseq_cons $1 $2 elts + in PaRecord {r_elts; r_terminator = None} } +| expr ";"? { PaSingleExpr $1 } sequence_or_record: - LBRACE sequence_or_record_in RBRACE { + "{" sequence_or_record_in "}" { let compound = Braces($1, $3) in let region = cover $1 $3 in match $2 with - | PaSequence s -> ( - let value: expr injection = { - compound; - elements = Some s.s_elts; - terminator = s.s_terminator; - } - in - ESeq {value; region} - ) - | PaRecord r -> ( + PaSequence s -> + let value: expr injection = { + compound; + elements = Some s.s_elts; + terminator = s.s_terminator} + in ESeq {region; value} + | PaRecord r -> let value: field_assign reg ne_injection = { compound; ne_elements = r.r_elts; - terminator = r.r_terminator; - } - in - ERecord {value; region} - ) - | PaSingleExpr e -> e - } + terminator = r.r_terminator} + in ERecord {region; value} + | PaSingleExpr e -> e } field_assignment: field_name { - { value = - { - field_name = $1; - assignment = Region.ghost; - field_expr = EVar $1 - }; - region = $1.region - } + let value = { + field_name = $1; + assignment = Region.ghost; + field_expr = EVar $1 } + in {$1 with value} } - | field_name COLON expr { - let start = $1.region in - let stop = expr_to_region $3 in +| field_name ":" expr { + let start = $1.region in + let stop = expr_to_region $3 in let region = cover start stop in - { value = - { - field_name = $1; - assignment = $2; - field_expr = $3 - }; - region - } - } + let value = { + field_name = $1; + assignment = $2; + field_expr = $3} + in {region; value} } diff --git a/src/passes/1-parser/reasonligo/Stubs/Parser_cameligo.ml b/src/passes/1-parser/reasonligo/Stubs/Parser_cameligo.ml new file mode 100644 index 000000000..bf4e0962a --- /dev/null +++ b/src/passes/1-parser/reasonligo/Stubs/Parser_cameligo.ml @@ -0,0 +1 @@ +module AST = AST diff --git a/src/passes/1-parser/reasonligo/Stubs/Simple_utils.ml b/src/passes/1-parser/reasonligo/Stubs/Simple_utils.ml new file mode 100644 index 000000000..0360af1b5 --- /dev/null +++ b/src/passes/1-parser/reasonligo/Stubs/Simple_utils.ml @@ -0,0 +1,2 @@ +module Region = Region +module Pos = Pos diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index 7483c0bf8..054d7272c 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -155,11 +155,10 @@ let rec pattern_to_typed_var : Raw.pattern -> _ = fun p -> | Raw.PWild r -> ok (({ region = r ; value = "_" } : Raw.variable) , None) | _ -> fail @@ wrong_pattern "typed variable" p -let rec expr_to_typed_expr : Raw.expr -> _ = fun e -> - match e with - | EPar e -> expr_to_typed_expr e.value.inside - | EAnnot a -> ok (fst a.value , Some (snd a.value)) - | _ -> ok (e , None) +let rec expr_to_typed_expr : Raw.expr -> _ = function + EPar e -> expr_to_typed_expr e.value.inside +| EAnnot {value={inside=e,_,t; _}; _} -> ok (e, Some t) +| e -> ok (e , None) let patterns_to_var : Raw.pattern nseq -> _ = fun ps -> match ps with @@ -266,7 +265,7 @@ let rec simpl_expression : let%bind body = simpl_expression body in return @@ e_let_in (Var.of_name variable.value , None) rhs' body | Raw.EAnnot a -> - let (expr , type_expr), loc = r_split a in + let Raw.{inside=expr, _, type_expr; _}, loc = r_split a in let%bind expr' = simpl_expression expr in let%bind type_expr' = simpl_type_expression type_expr in return @@ e_annotation ~loc expr' type_expr'