Michelson: fix and extend macro expansion.

fixes #114
fixes #115

src/client/embedded/bootstrap/concrete_parser.mly

@@ -22,7 +22,9 @@
 
 open Script_located_ir
 
-let expand_caddadr loc str =
+let expand_caddadr original =
+  match original with
+  | Prim (loc, str, []) ->
      let len = String.length str in
      if len > 3
         && String.get str 0 = 'C'
@@ -38,6 +40,7 @@ let expand_caddadr loc str =
        parse (len - 2) []
      else
        None
+  | _ -> None
 
 exception Not_a_roman
 
@@ -64,33 +67,40 @@ let decimal_of_roman roman =
   done;
   !arabic
 
-let expand_dxiiivp loc str arg =
+let expand_dxiiivp original =
+  match original with
+  | Prim (loc, str, [ arg ]) ->
      let len = String.length str in
      if len > 3
         && String.get str 0 = 'D'
         && String.get str (len - 1) = 'P' then
        try
          let depth = decimal_of_roman (String.sub str 1 (len - 2)) in
-      let rec make i =
+         let rec make i acc =
            if i = 0 then
-          arg
+             acc
            else
-          let sub = make (i - 1) in
+             make (i - 1)
-          Prim (loc, "DIP", [ Seq (loc, [ sub ]) ]) in
+               (Seq (loc, [ Prim (loc, "DIP", [ acc ]) ])) in
-      Some (make depth)
+         Some (make depth arg)
        with Not_a_roman -> None
      else None
+  | _ -> None
 
 exception Not_a_pair
 
-let expand_paaiair loc str =
+let expand_paaiair original =
+  match original with
+  | Prim (loc, str, []) ->
      let len = String.length str in
      if len > 4
         && String.get str 0 = 'P'
         && String.get str (len - 1) = 'R' then
        try
          let rec parse i acc =
-        if String.get str i = 'I'
+           if i = 0 then
+             acc
+           else if String.get str i = 'I'
               && String.get str (i - 1) = 'A' then
              parse (i - 2) (Prim (loc, "PAIR", []) :: acc)
            else if String.get str i = 'A' then
@@ -105,23 +115,115 @@ let expand_paaiair loc str =
        with Not_a_pair -> None
      else
        None
+  | _ -> None
 
-let expand = function
+exception Not_a_dup
-  | Prim (loc, name, [ arg ]) as original ->
+
-      begin match expand_dxiiivp loc name arg with
+let expand_duuuuup original =
+  match original with
+  | Prim (loc, str, []) ->
+     let len = String.length str in
+     if len > 3
+        && String.get str 0 = 'D'
+        && String.get str 1 = 'U'
+        && String.get str (len - 1) = 'P' then
+       try
+         let rec parse i acc =
+           if i = 1 then acc
+           else if String.get str i = 'U' then
+             parse (i - 1)
+                   (Seq (loc, [ Prim (loc, "DIP", [ acc ]) ;
+                                Prim (loc, "SWAP", []) ]))
+           else
+             raise Not_a_dup in
+         Some (parse (len - 2) (Seq (loc, [ Prim (loc, "DUP", []) ])))
+       with Not_a_dup -> None
+     else
+       None
+  | _ -> None
+
+
+let expand_compare original =
+  match original with
+  | Prim (loc, "CMPEQ", []) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "EQ", []) ]))
+  | Prim (loc, "CMPNEQ", []) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "NEQ", []) ]))
+  | Prim (loc, "CMPLT", []) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "LT", []) ]))
+  | Prim (loc, "CMPGT", []) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "GT", []) ]))
+  | Prim (loc, "CMPLE", []) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "LE", []) ]))
+  | Prim (loc, "CMPGE", []) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "GE", []) ]))
+  | Prim (loc, "IFCMPEQ", args) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "EQ", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFCMPNEQ", args) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "NEQ", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFCMPLT", args) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "LT", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFCMPGT", args) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "GT", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFCMPLE", args) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "LE", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFCMPGE", args) ->
+     Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
+                       Prim (loc, "GE", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFEQ", args) ->
+     Some (Seq (loc, [ Prim (loc, "EQ", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFNEQ", args) ->
+     Some (Seq (loc, [ Prim (loc, "NEQ", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFLT", args) ->
+     Some (Seq (loc, [ Prim (loc, "LT", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFGT", args) ->
+     Some (Seq (loc, [ Prim (loc, "GT", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFLE", args) ->
+     Some (Seq (loc, [ Prim (loc, "LE", []) ;
+                       Prim (loc, "IF", args) ]))
+  | Prim (loc, "IFGE", args) ->
+     Some (Seq (loc, [ Prim (loc, "GE", []) ;
+                       Prim (loc, "IF", args) ]))
+  | _ -> None
+
+let expand original =
+  let try_expansions expanders =
+    match
+      List.fold_left
+        (fun acc f ->
+          match acc with
+          | None -> f original
+          | Some rewritten -> Some rewritten)
+        None expanders with
     | None -> original
-        | Some rewritten -> rewritten
+    | Some rewritten -> rewritten in
-      end
+  try_expansions
-  | Prim (loc, name, []) as original ->
+    [ expand_dxiiivp ;
-      begin match expand_paaiair loc name with
+      expand_paaiair ;
-        | None ->
+      expand_caddadr ;
-            begin match expand_caddadr loc name with
+      expand_duuuuup ;
-              | None -> original
+      expand_compare ]
-              | Some rewritten -> rewritten
-            end
-        | Some rewritten -> rewritten
-      end
-  | original -> original
 
 let apply node arg =
   match node with

src/proto/bootstrap/docs/language.md

@@ -539,11 +539,11 @@ combinators, and also for branching.
 
    * `IF{EQ|NEQ|LT|GT|LE|GE} bt bf`
 
-        > IFCMP(\op) ; C / S   =>   (\op) ; IF bt bf ; C / S
+        > IF(\op) ; C / S   =>   (\op) ; IF bt bf ; C / S
 
    * `IFCMP{EQ|NEQ|LT|GT|LE|GE} bt bf`
 
-        > IFCMP(\op) ; C / S   =>   COMPARE ; IF(\op) bt bf ; C / S
+        > IFCMP(\op) ; C / S   =>   COMPARE ; (\op) ; IF bt bf ; C / S
 
 
 V - Operations