From e0cac4bd50cd9c8eb65dd5a0a9d3c3babd403036 Mon Sep 17 00:00:00 2001
From: Christian Rinderknecht <Christian.Rinderknecht@tezcore.com>
Date: Tue, 2 Apr 2019 10:22:47 +0200
Subject: [PATCH] Factored the parsing of case constructs for expressions and
 instructions.

---
 src/ligo/ligo-parser/Parser.mly | 106 ++++++++++++--------------------
 src/ligo/ligo-parser/Utils.ml   |  11 ++++
 src/ligo/ligo-parser/Utils.mli  |   6 ++
 3 files changed, 58 insertions(+), 65 deletions(-)

diff --git a/src/ligo/ligo-parser/Parser.mly b/src/ligo/ligo-parser/Parser.mly
index ae0e8f088..5dd547e6e 100644
--- a/src/ligo/ligo-parser/Parser.mly
+++ b/src/ligo/ligo-parser/Parser.mly
@@ -681,39 +681,48 @@ if_clause:
    ClauseBlock {value; region}}
 
 case_instr:
-  Case expr Of option(VBAR) cases_instr End {
-    let region = cover $1 $6 in
-    let value  = {
-      kwd_case  = $1;
-      expr      = $2;
-      opening   = Kwd $3;
-      lead_vbar = $4;
-      cases     = $5;
-      closing   = End $6}
-    in {region; value}
+  case(instruction) { $1 instr_to_region }
+
+case(rhs):
+  Case expr Of option(VBAR) cases(rhs) End {
+    fun rhs_to_region ->
+      let region = cover $1 $6 in
+      let value  = {
+        kwd_case  = $1;
+        expr      = $2;
+        opening   = Kwd $3;
+        lead_vbar = $4;
+        cases     = $5 rhs_to_region;
+        closing   = End $6}
+      in {region; value}
   }
-| Case expr Of LBRACKET option(VBAR) cases_instr RBRACKET {
-    let region = cover $1 $7 in
-    let value  = {
-      kwd_case  = $1;
-      expr      = $2;
-      opening   = KwdBracket ($3,$4);
-      lead_vbar = $5;
-      cases     = $6;
-      closing   = RBracket $7}
-    in {region; value}}
+| Case expr Of LBRACKET option(VBAR) cases(rhs) RBRACKET {
+    fun rhs_to_region ->
+      let region = cover $1 $7 in
+      let value  = {
+        kwd_case  = $1;
+        expr      = $2;
+        opening   = KwdBracket ($3,$4);
+        lead_vbar = $5;
+        cases     = $6 rhs_to_region;
+        closing   = RBracket $7}
+      in {region; value}}
 
-cases_instr:
-  nsepseq(case_clause_instr,VBAR) {
-    let region = nsepseq_to_region (fun x -> x.region) $1
-    in {region; value = $1}}
+cases(rhs):
+  nsepseq(case_clause(rhs),VBAR) {
+    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}}
 
-case_clause_instr:
-  pattern ARROW instruction {
-    let start  = pattern_to_region $1 in
-    let region = cover start (instr_to_region $3)
-    and value  = {pattern=$1; arrow=$2; rhs=$3}
-    in {region; value}}
+case_clause(rhs):
+  pattern ARROW 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}}
 
 assignment:
   lhs ASS rhs {
@@ -785,42 +794,9 @@ interactive_expr:
   expr EOF { $1 }
 
 expr:
-  case_expr { $1 }
-| disj_expr { $1 }
+  case(expr) { ECase ($1 expr_to_region) }
+| disj_expr  { $1                        }
 
-case_expr:
-  Case expr Of option(VBAR) cases_expr End {
-    let region = cover $1 $6 in
-    let value : expr case = {
-      kwd_case  = $1;
-      expr      = $2;
-      opening   = Kwd $3;
-      lead_vbar = $4;
-      cases     = $5;
-      closing   = End $6}
-    in ECase {region; value}}
-| Case expr Of LBRACKET option(VBAR) cases_expr RBRACKET {
-    let region = cover $1 $7 in
-    let value  = {
-      kwd_case  = $1;
-      expr      = $2;
-      opening   = KwdBracket ($3,$4);
-      lead_vbar = $5;
-      cases     = $6;
-      closing   = RBracket $7}
-    in ECase {region; value}}
-
-cases_expr:
-  nsepseq(case_clause_expr,VBAR) {
-    let region = nsepseq_to_region (fun x -> x.region) $1
-    in {region; value = $1}}
-
-case_clause_expr:
-  pattern ARROW expr {
-    let start  = pattern_to_region $1 in
-    let region = cover start (expr_to_region $3)
-    and value  = {pattern=$1; arrow=$2; rhs=$3}
-    in {region; value}}
 
 disj_expr:
   disj_expr Or conj_expr {
diff --git a/src/ligo/ligo-parser/Utils.ml b/src/ligo/ligo-parser/Utils.ml
index 5c43d4bad..908c77930 100644
--- a/src/ligo/ligo-parser/Utils.ml
+++ b/src/ligo/ligo-parser/Utils.ml
@@ -79,6 +79,17 @@ let sepseq_foldr f = function
     None -> fun a -> a
 | Some s -> nsepseq_foldr f s
 
+(* Maps *)
+
+let nseq_map f (hd,tl) = f hd, List.map f tl
+
+let nsepseq_map f (hd,tl) =
+  f hd, List.map (fun (sep,item) -> (sep, f item)) tl
+
+let sepseq_map f = function
+      None -> None
+| Some seq -> Some (nsepseq_map f seq)
+
 (* Conversions to lists *)
 
 let nseq_to_list (x,y) = x::y
diff --git a/src/ligo/ligo-parser/Utils.mli b/src/ligo/ligo-parser/Utils.mli
index 6680f4829..db3a03c49 100644
--- a/src/ligo/ligo-parser/Utils.mli
+++ b/src/ligo/ligo-parser/Utils.mli
@@ -51,6 +51,12 @@ val nseq_foldr    : ('a -> 'b -> 'b) ->        'a nseq -> 'b -> 'b
 val nsepseq_foldr : ('a -> 'b -> 'b) -> ('a,'c) nsepseq -> 'b -> 'b
 val sepseq_foldr  : ('a -> 'b -> 'b) -> ('a,'c)  sepseq -> 'b -> 'b
 
+(* Maps *)
+
+val nseq_map    : ('a -> 'b) -> 'a nseq -> 'b nseq
+val nsepseq_map : ('a -> 'b) -> ('a,'c) nsepseq -> ('b,'c) nsepseq
+val sepseq_map  : ('a -> 'b) -> ('a,'c) sepseq -> ('b,'c) sepseq
+
 (* Conversions to lists *)
 
 val nseq_to_list    :        'a nseq -> 'a list