From 7a318f1a6406a970a8054d972d10a5b1c3350373 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Wed, 28 Oct 2015 14:36:10 +0000
Subject: [PATCH] Update printing of custom index operators

---
 parsing/pprintast.ml | 142 ++++++++++++++++++-------------------------
 1 file changed, 58 insertions(+), 84 deletions(-)

diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index 9f4939137..b871f04e9 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -419,90 +419,64 @@ class printer  ()= object(self:'self)
     if e.pexp_attributes <> [] then false
       (* should also check attributes underneath *)
     else match e.pexp_desc with
-    | Pexp_apply
-        ({pexp_desc=
-          Pexp_ident
-            {txt= Ldot (Lident (("Array"|"String") as s),"get");_};_},
-         [(_,e1);(_,e2)]) -> begin
-              let fmt:(_,_,_)format =
-                if s= "Array" then "@[%a.(%a)@]" else "@[%a.[%a]@]" in
-              pp f fmt   self#simple_expr e1 self#expression e2;
-              true
-            end
-    |Pexp_apply
-        ({pexp_desc=
-          Pexp_ident
-            {txt= Ldot (Lident (("Array"|"String") as s),
-                        "set");_};_},[(_,e1);(_,e2);(_,e3)])
-      ->
-        let fmt :(_,_,_) format=
-          if s= "Array" then
-            "@[%a.(%a)@ <-@;%a@]"
-          else
-            "@[%a.[%a]@ <-@;%a@]" in  (* @;< gives error here *)
-        pp f fmt self#simple_expr e1  self#expression e2  self#expression e3;
-        true
-    | Pexp_apply ({pexp_desc=Pexp_ident {txt=Lident "!";_};_}, [(_,e)]) -> begin
-        pp f "@[<hov>!%a@]" self#simple_expr e;
-        true
-    end
-    | Pexp_apply
-        ({pexp_desc=Pexp_ident
-                     {txt= Ldot (Ldot (Lident "Bigarray", array),
-                                 ("get"|"set" as gs)) ;_};_},
-         label_exprs) ->
-           begin match array, gs, label_exprs with
-           | "Genarray", "get",
-             [(_,a);(_,{pexp_desc=Pexp_array ls;_})] ->
-               pp f "@[%a.{%a}@]" self#simple_expr a
-                 (self#list ~sep:"," self#simple_expr ) ls;
-               true
-           | "Genarray", "set",
-             [(_,a);(_,{pexp_desc=Pexp_array ls;_});(_,c)] ->
-               pp f "@[%a.{%a}@ <-@ %a@]" self#simple_expr a
-                 (self#list ~sep:"," self#simple_expr ) ls self#simple_expr c;
-               true
-           | "Array1", "set", [(_,a);(_,i);(_,v)] ->
-               pp f "@[%a.{%a}@ <-@ %a@]"
-                  self#simple_expr a
-                  self#simple_expr i
-                  self#simple_expr v;
-               true
-           | "Array2", "set", [(_,a);(_,i1);(_,i2);(_,v)] ->
-               pp f "@[%a.{%a,%a}@ <-@ %a@]"
-                  self#simple_expr a
-                  self#simple_expr i1
-                  self#simple_expr i2
-                  self#simple_expr v;
-               true
-           | "Array3", "set", [(_,a);(_,i1);(_,i2);(_,i3);(_,v)] ->
-               pp f "@[%a.{%a,%a,%a}@ <-@ %a@]"
-                  self#simple_expr a
-                  self#simple_expr i1
-                  self#simple_expr i2
-                  self#simple_expr i3
-                  self#simple_expr v;
-               true
-           | "Array1", "get", [(_,a);(_,i)] ->
-               pp f "@[%a.{%a}@]"
-                  self#simple_expr a
-                  self#simple_expr i;
-               true
-           | "Array2", "get", [(_,a);(_,i1);(_,i2)] ->
-               pp f "@[%a.{%a,%a}@]"
-                  self#simple_expr a
-                  self#simple_expr i1
-                  self#simple_expr i2;
-               true
-           | "Array3", "get", [(_,a);(_,i1);(_,i2);(_,i3)] ->
-               pp f "@[%a.{%a,%a,%a}@]"
-                  self#simple_expr a
-                  self#simple_expr i1
-                  self#simple_expr i2
-                  self#simple_expr i3;
-               true
-           | _ -> false
-           end
+    | Pexp_apply ({ pexp_desc = Pexp_ident { txt = Lident s; _ }; _ }, args)
+      when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin
+        let args = List.map snd args in
+        match s, args with
+        | "!", [e] ->
+          pp f "@[<hov>!%a@]" self#simple_expr e;
+          true
+        | (".()"|".[]"|".{}"), [a; i] ->
+          let left = String.sub s 0 2 and right = String.sub s 2 1 in
+          pp f "@[%a%s%a%s@]"
+            self#simple_expr a
+            left self#expression i right;
+          true
+        | (".()<-"|".[]<-"|".{}<-"), [a; i; v] ->
+          let left = String.sub s 0 2 and right = String.sub s 2 1 in
+          pp f "@[%a%s%a%s@ <-@;%a@]" (* @;< gives error here *)
+            self#simple_expr a
+            left self#expression i right
+            self#expression v;
+          true
+        | ".{,}", [a; i1; i2] ->
+          pp f "@[%a.{%a,%a}@]"
+            self#simple_expr a
+            self#simple_expr i1
+            self#simple_expr i2;
+          true
+        | ".{,}<-", [a; i1; i2; v] ->
+          pp f "@[%a.{%a,%a}@ <-@ %a@]"
+            self#simple_expr a
+            self#simple_expr i1
+            self#simple_expr i2
+            self#simple_expr v;
+          true
+        | ".{,,}", [a; i1; i2; i3] ->
+          pp f "@[%a.{%a,%a,%a}@]"
+            self#simple_expr a
+            self#simple_expr i1
+            self#simple_expr i2
+            self#simple_expr i3;
+          true
+        | ".{,,}<-", [a; i1; i2; i3; v] ->
+          pp f "@[%a.{%a,%a,%a}@ <-@ %a@]"
+            self#simple_expr a
+            self#simple_expr i1
+            self#simple_expr i2
+            self#simple_expr i3
+            self#simple_expr v;
+          true
+        | ".{,..,}", [a; {pexp_desc = Pexp_array ls; pexp_attributes = []}] ->
+          pp f "@[%a.{%a}@]" self#simple_expr a
+            (self#list ~sep:"," self#simple_expr ) ls;
+          true
+        | ".{,..,}<-", [a; {pexp_desc = Pexp_array ls; pexp_attributes = []}; v] ->
+          pp f "@[%a.{%a}@ <-@ %a@]" self#simple_expr a
+            (self#list ~sep:"," self#simple_expr ) ls self#simple_expr v;
+          true
+        | _ -> false
+      end
     | _ -> false
   method expression f x =
     if x.pexp_attributes <> [] then begin