Merge branch 'rinderknecht-dev' into 'dev'

Removed sub-blocks from PascaLIGO.

See merge request ligolang/ligo!142

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

@@ -284,10 +284,6 @@ and var_decl = {
 }
 
 and instruction =
-  Single of single_instr
-| Block  of block reg
-
-and single_instr =
   Cond        of conditional reg
 | CaseInstr   of instruction case reg
 | Assign      of assignment reg
@@ -355,7 +351,11 @@ and conditional = {
 
 and if_clause =
   ClauseInstr of instruction
-| ClauseBlock of (statements * semi option) braces reg
+| ClauseBlock of clause_block
+
+and clause_block =
+  LongBlock  of block reg
+| ShortBlock of (statements * semi option) braces reg
 
 and set_membership = {
   set          : expr;
@@ -661,7 +661,7 @@ and comp_expr_to_region = function
 | Neq   {region; _} -> region
 
 and arith_expr_to_region = function
-| Add  {region; _}
+  Add  {region; _}
 | Sub  {region; _}
 | Mult {region; _}
 | Div  {region; _}
@@ -675,7 +675,7 @@ and string_expr_to_region = function
   Cat    {region; _}
 | String {region; _} -> region
 
-and annot_expr_to_region ({region; _}) = region
+and annot_expr_to_region {region; _} = region
 
 and list_expr_to_region = function
   Cons {region; _}
@@ -694,24 +694,27 @@ let path_to_region = function
 | Path {region; _} -> region
 
 let instr_to_region = function
-  Single Cond                {region; _}
+  Cond                {region; _}
-| Single CaseInstr           {region; _}
+| CaseInstr           {region; _}
-| Single Assign              {region; _}
+| Assign              {region; _}
-| Single Loop While          {region; _}
+| Loop While          {region; _}
-| Single Loop For ForInt     {region; _}
+| Loop For ForInt     {region; _}
-| Single Loop For ForCollect {region; _}
+| Loop For ForCollect {region; _}
-| Single ProcCall            {region; _}
+| ProcCall            {region; _}
-| Single Skip                region
+| Skip                region
-| Single RecordPatch         {region; _}
+| RecordPatch         {region; _}
-| Single MapPatch            {region; _}
+| MapPatch            {region; _}
-| Single SetPatch            {region; _}
+| SetPatch            {region; _}
-| Single MapRemove           {region; _}
+| MapRemove           {region; _}
-| Single SetRemove           {region; _}
+| SetRemove           {region; _} -> region
-| Block                      {region; _} -> region
+
+let clause_block_to_region = function
+  LongBlock {region; _}
+| ShortBlock {region; _} -> region
 
 let if_clause_to_region = function
   ClauseInstr instr       -> instr_to_region instr
-| ClauseBlock {region; _} -> region
+| ClauseBlock clause_block -> clause_block_to_region clause_block
 
 let pattern_to_region = function
   PCons       {region; _}

src/passes/1-parser/pascaligo/AST.mli

@@ -275,10 +275,6 @@ and var_decl = {
 }
 
 and instruction =
-  Single of single_instr
-| Block  of block reg
-
-and single_instr =
   Cond        of conditional reg
 | CaseInstr   of instruction case reg
 | Assign      of assignment reg
@@ -346,7 +342,11 @@ and conditional = {
 
 and if_clause =
   ClauseInstr of instruction
-| ClauseBlock of (statements * semi option) braces reg
+| ClauseBlock of clause_block
+
+and clause_block =
+  LongBlock  of block reg
+| ShortBlock of (statements * semi option) braces reg
 
 and set_membership = {
   set          : expr;

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

@@ -377,10 +377,6 @@ var_decl:
 | open_var_decl { $1 }
 
 instruction:
-  single_instr {      Single $1 }
-| block        {      Block  $1 }
-
-single_instr:
   conditional  {        Cond $1 }
 | case_instr   {   CaseInstr $1 }
 | assignment   {      Assign $1 }
@@ -512,16 +508,19 @@ conditional:
     in {region; value} }
 
 if_clause:
-  instruction {
+  instruction  { ClauseInstr $1 }
-    ClauseInstr $1
+| clause_block { ClauseBlock $1 }
-  }
+
+clause_block:
+  block {
+    LongBlock $1 }
 | LBRACE sep_or_term_list(statement,SEMI) RBRACE {
     let region = cover $1 $3 in
     let value = {
       lbrace = $1;
       inside = $2;
       rbrace = $3} in
-   ClauseBlock {value; region} }
+    ShortBlock {value; region} }
 
 case_instr:
   case(instruction) { $1 instr_to_region }

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

@@ -244,10 +244,6 @@ and print_statement buffer = function
 | Data  data  -> print_data_decl   buffer data
 
 and print_instruction buffer = function
-  Single instr -> print_single_instr buffer instr
-| Block  block -> print_block        buffer block
-
-and print_single_instr buffer = function
   Cond        {value; _} -> print_conditional buffer value
 | CaseInstr   {value; _} -> print_case_instr buffer value
 | Assign      assign     -> print_assignment buffer assign
@@ -273,7 +269,12 @@ and print_conditional buffer node =
 
 and print_if_clause buffer = function
   ClauseInstr instr -> print_instruction buffer instr
-| ClauseBlock {value; _} ->
+| ClauseBlock block -> print_clause_block buffer block
+
+and print_clause_block buffer = function
+  LongBlock block ->
+    print_block buffer block
+| ShortBlock {value; _} ->
     let {lbrace; inside; rbrace} = value in
     let statements, terminator = inside in
     print_token      buffer lbrace "{";
@@ -885,14 +886,6 @@ and pp_statement buffer ~pad:(_,pc as pad) = function
     pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data_decl
 
 and pp_instruction buffer ~pad:(_,pc as pad) = function
-  Single single_instr ->
-    pp_node buffer ~pad "Single";
-    pp_single_instr buffer ~pad:(mk_pad 1 0 pc) single_instr
-| Block {value; _} ->
-    pp_node buffer ~pad "Block";
-    pp_statements buffer ~pad value.statements
-
-and pp_single_instr buffer ~pad:(_,pc as pad) = function
   Cond {value; _} ->
     pp_node buffer ~pad "Cond";
     pp_conditional buffer ~pad value
@@ -945,9 +938,17 @@ and pp_if_clause buffer ~pad:(_,pc as pad) = function
   ClauseInstr instr ->
     pp_node buffer ~pad "ClauseInstr";
     pp_instruction buffer ~pad:(mk_pad 1 0 pc) instr
-| ClauseBlock {value; _} ->
+| ClauseBlock block ->
     pp_node buffer ~pad "ClauseBlock";
-    let statements, _ = value.inside in
+    pp_clause_block buffer ~pad:(mk_pad 1 0 pc) block
+
+and pp_clause_block buffer ~pad = function
+  LongBlock {value; _} ->
+    pp_node buffer ~pad "LongBlock";
+    pp_statements buffer ~pad value.statements
+| ShortBlock {value; _} ->
+    pp_node buffer ~pad "ShortBlock";
+    let statements = fst value.inside in
     pp_statements buffer ~pad statements
 
 and pp_case :

src/passes/2-simplify/pascaligo.ml

@@ -147,16 +147,6 @@ module Errors = struct
     ] in
     error ~data title message
 
-  let unsupported_sub_blocks b =
-    let title () = "block instructions" in
-    let message () =
-      Format.asprintf "Sub-blocks are not supported yet" in
-    let data = [
-      ("block_loc",
-       fun () -> Format.asprintf "%a" Location.pp_lift @@ b.Region.region)
-    ] in
-    error ~data title message
-
   (* Logging *)
 
   let simplifying_instruction t =
@@ -555,11 +545,8 @@ and simpl_fun_declaration :
   fun ~loc x ->
   let open! Raw in
   let {name;param;ret_type;local_decls;block;return} : fun_decl = x in
-  (match npseq_to_list param.value.inside with
+  (match param.value.inside with
-   | [] ->
+     a, [] -> (
-       fail @@
-       corner_case ~loc:__LOC__ "parameter-less function should not exist"
-   | [a] -> (
        let%bind input = simpl_param a in
        let name = name.value in
        let (binder , input_type) = input in
@@ -580,6 +567,7 @@ and simpl_fun_declaration :
        ok ((name , type_annotation) , expression)
      )
    | lst -> (
+       let lst = npseq_to_list lst in
        let arguments_name = "arguments" in
        let%bind params = bind_map_list simpl_param lst in
        let (binder , input_type) =
@@ -640,7 +628,7 @@ and simpl_statement : Raw.statement -> (_ -> expression result) result =
   | Instr i -> simpl_instruction i
   | Data d -> simpl_data_declaration d
 
-and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) result =
+and simpl_single_instruction : Raw.instruction -> (_ -> expression result) result =
   fun t ->
   match t with
   | ProcCall x -> (
@@ -672,11 +660,23 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
       let (c , loc) = r_split c in
       let%bind expr = simpl_expression c.test in
       let%bind match_true = match c.ifso with
-        | ClauseInstr i -> simpl_instruction_block i
+          ClauseInstr i ->
-        | ClauseBlock b -> simpl_statements @@ fst b.value.inside in
+            simpl_single_instruction i
+        | ClauseBlock b ->
+            match b with
+              LongBlock {value; _} ->
+                simpl_block value
+            | ShortBlock {value; _} ->
+                simpl_statements @@ fst value.inside in
       let%bind match_false = match c.ifnot with
-        | ClauseInstr i -> simpl_instruction_block i
+          ClauseInstr i ->
-        | ClauseBlock b -> simpl_statements @@ fst b.value.inside in
+            simpl_single_instruction i
+        | ClauseBlock b ->
+            match b with
+              LongBlock {value; _} ->
+                simpl_block value
+            | ShortBlock {value; _} ->
+                simpl_statements @@ fst value.inside in
       let%bind match_true = match_true None in
       let%bind match_false = match_false None in
       return_statement @@ e_matching expr ~loc (Match_bool {match_true; match_false})
@@ -708,7 +708,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
       let%bind expr = simpl_expression c.expr in
       let%bind cases =
         let aux (x : Raw.instruction Raw.case_clause Raw.reg) =
-          let%bind i = simpl_instruction_block x.value.rhs in
+          let%bind i = simpl_instruction x.value.rhs in
           let%bind i = i None in
           ok (x.value.pattern, i) in
         bind_list
@@ -914,18 +914,9 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t -
         bind_map_list aux lst in
       ok @@ Match_variant constrs
 
-and simpl_instruction_block : Raw.instruction -> (_ -> expression result) result =
-  fun t ->
-  match t with
-  | Single s -> simpl_single_instruction s
-  | Block b -> simpl_block b.value
-
 and simpl_instruction : Raw.instruction -> (_ -> expression result) result =
   fun t ->
-  trace (simplifying_instruction t) @@
+  trace (simplifying_instruction t) @@ simpl_single_instruction t
-  match t with
-  | Single s -> simpl_single_instruction s
-  | Block b -> fail @@ unsupported_sub_blocks b
 
 and simpl_statements : Raw.statements -> (_ -> expression result) result =
   fun ss ->