Merge branch 'rinderknecht@sequences' into 'dev'

Fixing the parsing of sequences in CameLIGO and ReasonLIGO

See merge request ligolang/ligo!605

src/bin/expect_tests/contract_tests.ml

@@ -1692,4 +1692,56 @@ let%expect_test _ =
     * Visit our documentation: https://ligolang.org/docs/intro/introduction
     * Ask a question on our Discord: https://discord.gg/9rhYaEt
     * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
-    * Check the changelog by running 'ligo changelog' |}]
+    * Check the changelog by running 'ligo changelog' |}];
+      
+  run_ligo_good ["print-ast"; contract "letin.mligo"];
+  [%expect {|
+    type storage = (int ,
+    int)
+    const main : (int ,
+    storage) -> ((TO_list(operation)) ,
+    storage) = lambda (n:Some((int ,
+    storage))) : None return let x = let x = 7 : int in (ADD(x ,
+    n.0) ,
+    ADD(n.1.0 ,
+    n.1.1)) : (int ,
+    int) in (list[] : (TO_list(operation)) ,
+    x)
+    const f0 = lambda (a:Some(string)) : None return true(unit)
+    const f1 = lambda (a:Some(string)) : None return true(unit)
+    const f2 = lambda (a:Some(string)) : None return true(unit)
+    const letin_nesting = lambda (_:Some(unit)) : None return let s = "test" in let p0 = (f0)@(s) in { ASSERTION(p0);
+     let p1 = (f1)@(s) in { ASSERTION(p1);
+     let p2 = (f2)@(s) in { ASSERTION(p2);
+     s}}}
+    const letin_nesting2 = lambda (x:Some(int)) : None return let y = 2 in let z = 3 in ADD(ADD(x ,
+    y) ,
+    z)
+    |}];
+
+  run_ligo_good ["print-ast"; contract "letin.religo"];
+  [%expect {|
+    type storage = (int ,
+    int)
+    const main : (int ,
+    storage) -> ((TO_list(operation)) ,
+    storage) = lambda (n:Some((int ,
+    storage))) : None return let x = let x = 7 : int in (ADD(x ,
+    n.0) ,
+    ADD(n.1.0 ,
+    n.1.1)) : (int ,
+    int) in (list[] : (TO_list(operation)) ,
+    x)
+    const f0 = lambda (a:Some(string)) : None return true(unit)
+    const f1 = lambda (a:Some(string)) : None return true(unit)
+    const f2 = lambda (a:Some(string)) : None return true(unit)
+    const letin_nesting = lambda (_:Some(unit)) : None return let s = "test" in let p0 = (f0)@(s) in { ASSERTION(p0);
+     let p1 = (f1)@(s) in { ASSERTION(p1);
+     let p2 = (f2)@(s) in { ASSERTION(p2);
+     s}}}
+    const letin_nesting2 = lambda (x:Some(int)) : None return let y = 2 in let z = 3 in ADD(ADD(x ,
+    y) ,
+    z)
+    |}];
+
+

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

@@ -166,7 +166,7 @@ and type_expr =
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
 | TVar    of variable
-| TStringLiteral of Lexer.lexeme reg
+| TString of Lexer.lexeme reg
 
 and cartesian = (type_expr, times) nsepseq reg
 
@@ -410,7 +410,7 @@ let type_expr_to_region = function
 | TApp {region; _}
 | TFun {region; _}
 | TPar {region; _}
-| TStringLiteral {region; _}
+| TString {region; _}
 | TVar {region; _} -> region
 
 let list_pattern_to_region = function

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

@@ -149,7 +149,7 @@ cartesian:
 core_type:
   type_name      {    TVar $1 }
 | par(type_expr) {    TPar $1 }
-| "<string>"     { TStringLiteral $1 }
+| "<string>"     { TString $1 }
 | module_name "." type_name {
     let module_name = $1.value in
     let type_name   = $3.value in
@@ -457,15 +457,14 @@ case_clause(right_expr):
 
 let_expr(right_expr):
   "let" ioption("rec") let_binding seq(Attr) "in" right_expr  {
-    let kwd_let    = $1
+    let stop   = expr_to_region $6 in
-    and kwd_rec    = $2
+    let region = cover $1 stop
-    and binding    = $3
+    and value  = {kwd_let    = $1;
-    and attributes = $4
+                  kwd_rec    = $2;
-    and kwd_in     = $5
+                  binding    = $3;
-    and body       = $6 in
+                  attributes = $4;
-    let stop       = expr_to_region body in
+                  kwd_in     = $5;
-    let region     = cover kwd_let stop
+                  body       = $6}
-    and value      = {kwd_let; kwd_rec; binding; kwd_in; body; attributes}
     in ELetIn {region; value} }
 
 fun_expr(right_expr):
@@ -476,8 +475,7 @@ fun_expr(right_expr):
                   binders    = $2;
                   lhs_type   = None;
                   arrow      = $3;
-                  body       = $4
+                  body       = $4}
-                 }
     in EFun {region; value} }
 
 disj_expr_level:
@@ -653,7 +651,8 @@ update_record:
 
 field_path_assignment :
   nsepseq(field_name,".") "=" expr {
-    let region = cover (nsepseq_to_region (fun x -> x.region) $1) (expr_to_region $3) in
+    let start  = nsepseq_to_region (fun x -> x.region) $1 in
+    let region = cover start (expr_to_region $3) in
     let value  = {field_path = $1;
                   assignment = $2;
                   field_expr = $3}
@@ -669,8 +668,12 @@ field_assignment:
                   field_expr = $3}
     in {region; value} }
 
+path :
+ "<ident>"   { Name $1 }
+| projection { Path $1 }
+
 sequence:
-  "begin" sep_or_term_list(expr,";")? "end" {
+  "begin" series? "end" {
     let region   = cover $1 $3
     and compound = BeginEnd ($1,$3) in
     let elements, terminator =
@@ -681,6 +684,36 @@ sequence:
     let value = {compound; elements; terminator}
     in {region; value} }
 
-path :
+series:
- "<ident>"   { Name $1 }
+  last_expr {
-| projection { Path $1 }
+    let expr, term = $1 in (expr, []), term
+  }
+| seq_expr ";" series {
+    let rest, term = $3 in
+    let seq = Utils.nsepseq_cons $1 $2 rest
+    in seq, term }
+
+last_expr:
+  seq_expr ";"?
+| fun_expr(seq_expr) ";"?
+| match_expr(seq_expr) ";"? {
+    $1,$2
+  }
+| "let" ioption("rec") let_binding seq(Attr) "in" series  {
+    let seq, term = $6 in
+    let stop      = nsepseq_to_region expr_to_region seq in
+    let region    = cover $1 stop in
+    let compound  = BeginEnd (Region.ghost, Region.ghost) in
+    let elements  = Some seq in
+    let value     = {compound; elements; terminator=term} in
+    let body      = ESeq {region; value} in
+    let value     = {kwd_let    = $1;
+                     kwd_rec    = $2;
+                     binding    = $3;
+                     attributes = $4;
+                     kwd_in     = $5;
+                     body}
+    in ELetIn {region; value}, term }
+
+seq_expr:
+  disj_expr_level | if_then_else (seq_expr) { $1 }

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

@@ -162,7 +162,7 @@ and print_type_expr state = function
 | TPar par        -> print_type_par state par
 | TVar var        -> print_var state var
 | TFun t          -> print_fun_type state t
-| TStringLiteral s -> print_string state s
+| TString s       -> print_string state s
 
 and print_fun_type state {value; _} =
   let domain, arrow, range = value in
@@ -1140,8 +1140,8 @@ and pp_type_expr state = function
  | TVar v ->
     pp_node  state "TVar";
     pp_ident (state#pad 1 0) v
- | TStringLiteral s ->
+ | TString s ->
-    pp_node   state "String";
+    pp_node   state "TString";
     pp_string (state#pad 1 0) s
 
 and pp_type_tuple state {value; _} =

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

@@ -8,20 +8,6 @@ open Region
 module AST = Parser_cameligo.AST
 open! AST
 
-type 'a sequence_elements = {
-  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
-}
-
-type 'a sequence_or_record =
-  PaSequence   of 'a sequence_elements
-| PaRecord     of 'a record_elements
-
 let (<@) f g x = f (g x)
 
 (*
@@ -58,7 +44,7 @@ let wild_error e =
 %type <AST.t> contract
 %type <AST.expr> interactive_expr
 
-(* Solves a shift/reduce problem that happens with record and
+(* Solves a shift/reduce problem that happens with records and
    sequences. To elaborate: [sequence_or_record_in]
    can be reduced to [expr -> Ident], but also to
    [field_assignment -> Ident].
@@ -206,7 +192,7 @@ type_args:
 
 core_type:
   type_name      {    TVar $1 }
-| "<string>"     { TStringLiteral $1 }
+| "<string>"     { TString $1 }
 | par(fun_type)  {    TPar $1 }
 | module_name "." type_name {
     let module_name = $1.value in
@@ -264,8 +250,11 @@ let_declaration:
     let kwd_rec    = $3 in
     let binding    = $4 in
     let value      = kwd_let, kwd_rec, binding, attributes in
-    let stop       = expr_to_region binding.let_rhs in
+    let start      = match $1 with
-    let region     = cover $2 stop
+                       [] -> $2
+                     | l  -> last (fun x -> x.region) l
+    and stop       = expr_to_region binding.let_rhs in
+    let region     = cover start stop
     in {region; value} }
 
 let_binding:
@@ -420,15 +409,12 @@ interactive_expr:
   expr_with_let_expr EOF { $1 }
 
 expr:
-  base_cond__open(expr) | switch_expr(base_cond) { $1 }
+  base_cond | switch_expr(base_cond) { $1 }
-
-base_cond__open(x):
-  base_expr(x) | conditional(expr_with_let_expr) {
-    wild_error $1;
-    $1 }
 
 base_cond:
-  base_cond__open(base_cond) { $1 }
+  base_expr | conditional(expr_with_let_expr) {
+    wild_error $1;
+    $1 }
 
 type_expr_simple_args:
   par(nsepseq(type_expr_simple, ",")) { $1 }
@@ -452,8 +438,8 @@ type_expr_simple:
 type_annotation_simple:
   ":" type_expr_simple { $1,$2 }
 
-fun_expr:
+fun_expr(right_expr):
-  disj_expr_level "=>" expr {
+  disj_expr_level "=>" right_expr {
     let arrow, body = $2, $3
     and kwd_fun     = ghost in
     let start       = expr_to_region $1
@@ -574,8 +560,8 @@ fun_expr:
             }
     in EFun {region; value=f} }
 
-base_expr(right_expr):
+base_expr:
-  disj_expr_level | fun_expr { $1 }
+  disj_expr_level | fun_expr(expr) { $1 }
 
 conditional(right_expr):
   if_then_else(right_expr) | if_then(right_expr) { $1 }
@@ -609,7 +595,7 @@ if_then_else(right_expr):
     in ECond {region; value} }
 
 base_if_then_else__open(x):
-  base_expr(x) | if_then_else(x) { $1 }
+  base_expr | if_then_else(x) { $1 }
 
 base_if_then_else:
   base_if_then_else__open(base_if_then_else) { $1 }
@@ -840,8 +826,9 @@ list_or_spread:
 
 core_expr:
   common_expr
-| list_or_spread
+| list_or_spread      {         $1 }
-| sequence_or_record  {      $1 }
+| sequence            {    ESeq $1 }
+| record              { ERecord $1 }
 | par(expr)           {    EPar $1 }
 
 module_field:
@@ -912,56 +899,95 @@ update_record:
     in {region; value} }
 
 expr_with_let_expr:
-  expr { $1 }
+  expr
 | let_expr(expr_with_let_expr) { $1 }
 
+exprs: 
+  expr_with_let_expr ";"? { 
+    (($1, []), $2) 
+  }
+| expr_with_let_expr ";" exprs {
+  let rec fix_let_in a b c =
+    match a with 
+    | ELetIn {value = {body; _} as v; _} -> (
+      let end_ = (nsepseq_to_region expr_to_region (fst c)) in
+      let sequence_region = 
+        cover (expr_to_region body) end_
+      in
+      let val_ = 
+        match body with 
+        | ELetIn _ -> fst (fix_let_in body b c)
+        | e -> Utils.nsepseq_cons e b (fst c)
+      in
+      let sequence = ESeq {
+        value = {
+          compound = BeginEnd(Region.ghost, Region.ghost);
+          elements = Some val_;
+          terminator = (snd c)
+        };
+        region = sequence_region
+      }
+      in 
+      let region = 
+        cover (expr_to_region a) end_
+      in
+      let let_in = 
+        ELetIn { 
+          value = {
+            v with
+            body = sequence
+          }; 
+          region 
+        }
+      in
+      ((let_in, []), snd c) 
+    )
+    | e -> Utils.nsepseq_cons e b (fst c), None
+  in 
+  fix_let_in $1 $2 $3
+}
+
 more_field_assignments:
   "," sep_or_term_list(field_assignment_punning,",") {
+    let elts, _region = $2
+    in $1, elts }
+
+sequence: 
+  "{" exprs "}" {
     let elts, _region = $2 in    
-    $1, elts
-  }
-
-
-sequence_or_record_in:
-  sep_or_term_list(expr_with_let_expr,";") {
-    let elts, _region = $1 in
-    PaSequence {s_elts = elts; s_terminator=None}
-  }
-| field_assignment more_field_assignments? {
-    match $2 with
-    | Some (comma, elts) ->
-      let r_elts = Utils.nsepseq_cons $1 comma elts in
-      PaRecord {r_elts; r_terminator = None}
-    | None ->
-      PaRecord {r_elts = ($1, []); r_terminator = None}
-  }
-| field_name more_field_assignments {
-  let value = {
-    field_name = $1;
-    assignment = ghost;
-    field_expr = EVar $1 }
-  in 
-  let field_name = {$1 with value} in
-  let (comma, elts) = $2 in
-  let r_elts = Utils.nsepseq_cons field_name comma elts in 
-  PaRecord {r_elts; r_terminator = None}
-}
-
-sequence_or_record:
-  "{" sequence_or_record_in "}" {
     let compound = Braces ($1, $3) in
+    let value = {compound;
+                     elements = Some elts;
+                     terminator = None} in
     let region   = cover $1 $3 in  
-    match $2 with
+    {region; value}
-      PaSequence s ->
+  }
-        let value = {compound;
+
-                     elements = Some s.s_elts;
+record: 
-                     terminator = s.s_terminator}
+  "{" field_assignment more_field_assignments? "}" {
-        in ESeq {region; value}
+    let compound = Braces ($1,$4) in
-    | PaRecord r ->
+    let region   = cover $1 $4 in
-        let value = {compound;
+
-                     ne_elements = r.r_elts;
+    match $3 with
-                     terminator = r.r_terminator}
+    | Some (comma, elts) ->
-        in ERecord {region; value}}
+        let ne_elements = Utils.nsepseq_cons $2 comma elts in    
+        { value = {compound; ne_elements; terminator = None}; region }
+    | None ->
+        let ne_elements = ($2,[]) in
+        { value = {compound; ne_elements; terminator = None}; region }
+  }
+| "{" field_name more_field_assignments "}" {
+    let value = {
+      field_name = $2;
+      assignment = ghost;
+      field_expr = EVar $2 } in
+    let field_name = {$2 with value} in
+    let comma, elts = $3 in
+    let ne_elements = Utils.nsepseq_cons field_name comma elts in
+    let compound = Braces ($1,$4) in
+    let region   = cover $1 $4 in
+    { value = {compound; ne_elements; terminator = None}; region }
+  }
 
 field_assignment_punning:
   (* This can only happen with multiple fields -
@@ -971,12 +997,9 @@ field_assignment_punning:
       field_name = $1;
       assignment = ghost;
       field_expr = EVar $1 }
-    in
+    in {$1 with value}
-    {$1 with value}
-  }
-| field_assignment {
-    $1
   }
+| field_assignment { $1 }
 
 field_assignment:
   field_name ":" expr {

src/passes/2-concrete_to_imperative/cameligo.ml

@@ -169,7 +169,7 @@ open Operators.Concrete_to_imperative.Cameligo
 let r_split = Location.r_split
 
 let get_t_string_singleton_opt = function
-  | Raw.TStringLiteral s -> Some s.value
+  | Raw.TString s -> Some s.value
   | _ -> None
 
 let rec pattern_to_var : Raw.pattern -> _ = fun p ->
@@ -321,7 +321,7 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te -
         @@ npseq_to_list s in
       let m = List.fold_left (fun m ((x,i), y) -> CMap.add (Constructor x) {ctor_type=y;ctor_decl_pos=i} m) CMap.empty lst in
       ok @@ make_t ~loc @@ T_sum m
-  | TStringLiteral _s -> simple_fail "we don't support singleton string type"
+  | TString _s -> simple_fail "we don't support singleton string type"
 
 and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result =
   match lst with

src/test/contracts/letin.mligo

@@ -5,3 +5,25 @@ let main (n : int * storage) : operation list * storage =
     let x : int = 7
     in x + n.0, n.1.0 + n.1.1
   in ([] : operation list), x
+
+
+let f0 (a: string) = true
+let f1 (a: string) = true
+let f2 (a: string) = true
+
+let letin_nesting (_: unit) =
+  begin
+    let s = "test" in
+    let p0 = f0 s in
+    assert p0;
+    let p1 = f1 s in
+    assert p1;
+    let p2 = f2 s in
+    assert p2;
+    s
+  end
+
+let letin_nesting2 (x: int) = 
+  let y = 2 in 
+  let z = 3 in
+  x + y + z

src/test/contracts/letin.religo

@@ -7,3 +7,24 @@ let main = (n : (int, storage)) : (list (operation), storage) => {
   };
   ([]: list (operation), x);
 };
+
+let f0 = (a: string) => true
+let f1 = (a: string) => true
+let f2 = (a: string) => true
+
+let letin_nesting = (_: unit) => {
+  let s = "test";
+  let p0 = f0(s);
+  assert(p0);
+  let p1 = f1(s);
+  assert(p1);
+  let p2 = f2(s);
+  assert(p2);
+  s
+}
+
+let letin_nesting2 = (x: int) => {
+  let y = 2;
+  let z = 3;
+  x + y + z
+}

src/test/integration_tests.ml

@@ -1595,18 +1595,37 @@ let counter_religo () : unit result =
 
 let let_in_mligo () : unit result =
   let%bind program = mtype_file "./contracts/letin.mligo" in
+  let%bind () = 
     let make_input n = e_pair (e_int n) (e_pair (e_int 3) (e_int 5)) in
     let make_expected n =
       e_pair (e_typed_list [] (t_operation ())) (e_pair (e_int (7+n)) (e_int (3+5)))
-  in expect_eq_n program "main" make_input make_expected
+    in 
+    expect_eq_n program "main" make_input make_expected
+  in 
+  let%bind () = 
+    expect_eq program "letin_nesting" (e_unit ()) (e_string "test")
+  in 
+  let%bind () = 
+    expect_eq program "letin_nesting2" (e_int 4) (e_int 9)
+  in 
+  ok ()
 
 let let_in_religo () : unit result =
   let%bind program = retype_file "./contracts/letin.religo" in
+  let%bind () = 
     let make_input n = e_pair (e_int n) (e_pair (e_int 3) (e_int 5)) in
     let make_expected n =
       e_pair (e_typed_list [] (t_operation ())) (e_pair (e_int (7+n)) (e_int (3+5)))
-  in expect_eq_n program "main" make_input make_expected
+    in 
-
+    expect_eq_n program "main" make_input make_expected
+  in 
+  let%bind () = 
+    expect_eq program "letin_nesting" (e_unit ()) (e_string "test")
+  in 
+  let%bind () = 
+    expect_eq program "letin_nesting2" (e_int 4) (e_int 9)
+  in
+  ok ()
 
 let match_variant () : unit result =
   let%bind program = mtype_file "./contracts/match.mligo" in