Michelson: tests for new parser and macro expander

src/client/embedded/alpha/michelson_macros.ml

@@ -353,6 +353,54 @@ let expand_compare original =
   | Prim (loc, "IFGE", args, None) ->
       Some (Seq (loc, [ Prim (loc, "GE", [], None) ;
                         Prim (loc, "IF", args, None) ], None))
+  | _ -> None;;
+
+
+let expand_asserts original =
+  let fail_false loc =
+    [ Seq(loc, [], None) ; Seq(loc, [ Prim (loc, "FAIL", [], None) ], None) ] in
+  let fail_true loc =
+    [ Seq(loc, [ Prim (loc, "FAIL", [], None) ], None) ; Seq(loc, [], None) ] in
+  match original with
+  | Prim (loc, "ASSERT", [], None) ->
+      Some (Seq (loc, [ Prim (loc, "IF", fail_false loc, None) ], None))
+  | Prim (loc, "ASSERT_NONE", [], None) ->
+      Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_false loc, None) ], None))
+  | Prim (loc, "ASSERT_SOME", [], None) ->
+      Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_true loc, None) ], None))
+  | Prim (loc, "ASSERT_LEFT", [], None) ->
+      Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_false loc, None) ], None))
+  | Prim (loc, "ASSERT_RIGHT", [], None) ->
+      Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_true loc, None) ], None))
+  | Prim (loc, s, [], None)
+    when String.(length s >  7 && equal (sub s 0 7) "ASSERT_") ->
+      begin
+        let remaining = String.(sub s 7 ((length s) - 7)) in
+        let remaining_prim = Prim(loc, remaining, [], None) in
+        match remaining with
+        | "EQ" | "NEQ" | "LT" | "LE" | "GE" | "GT" ->
+            Some (Seq (loc, [ remaining_prim ;
+                              Prim (loc, "IF", fail_false loc, None) ], None))
+        | _ ->
+            begin
+              match expand_compare remaining_prim with
+            | None -> None
+            | Some seq ->
+                Some (Seq (loc, [ seq ;
+                                  Prim (loc, "IF", fail_false loc, None) ], None))
+          end
+      end
+  | _ -> None
+
+
+let expand_if_some = function
+  | Prim (loc, "IF_SOME", [ right ; left ], None) ->
+      Some (Seq (loc, [ Prim (loc, "IF_NONE", [ left ; right ], None) ], None))
+  | _ -> None
+
+let expand_if_right = function
+  | Prim (loc, "IF_RIGHT", [ right ; left ], None) ->
+      Some (Seq (loc, [ Prim (loc, "IF_LEFT", [ left ; right ], None) ], None))
   | _ -> None
 
 let expand original =
@@ -374,7 +422,10 @@ let expand original =
       expand_paaiair ;
       expand_unpaaiair ;
       expand_duuuuup ;
-      expand_compare ]
+      expand_compare ;
+      expand_asserts ;
+      expand_if_some ;
+      expand_if_right ]
 
 open Script
 
@@ -521,27 +572,23 @@ let unexpand_dxiiivp expanded =
   | _ -> None
 
 let unexpand_duuuuup expanded =
-  let is_duuuuup_prim_name str =
+  let rec help expanded =
-    let len = String.length str in
+    match expanded with
-    len >= 3
+    | Seq (loc, [ Prim (_, "DUP", [], None) ], None) -> Some (loc, 1)
-    && String.get str 0 = 'D'
+    | Seq (_, [ Prim (_, "DIP", [expanded'], None);
-    && String.get str (len - 1) = 'P'
+                Prim (_, "SWAP", [], None) ], None) ->
-    && begin
+        begin
-      let all_u = ref true in
+          match help expanded' with
-      for i = 1 to len - 2 do
+          | None -> None
-        all_u := !all_u && String.get str i = 'U'
+          | Some (loc, n) -> Some (loc, n + 1)
-      done ;
+        end
-      !all_u
+    | _ -> None
-    end in
+  in let rec dupn = function
-  match expanded with
+      | 0 -> "P"
-  | Seq (loc,
+      | n -> "U" ^ (dupn (n - 1)) in
-         [ Prim (_, "DIP",
+  match help expanded with
-                 [ Prim (_, sub, [], None) ], None) ;
+  | None -> None
-           Prim (_, "SWAP", [], None) ], None)
+  | Some (loc, n) -> Some (Prim (loc, "D" ^ (dupn n), [], None))
-    when is_duuuuup_prim_name sub ->
-      let name = "DU" ^ String.sub sub 1 (String.length sub - 1) in
-      Some (Prim (loc, name, [], None))
-  | _ -> None
 
 let unexpand_paaiair expanded =
   match expanded with
@@ -650,6 +697,51 @@ let unexpand_compare expanded =
       Some (Prim (loc, "IFGE", args, None))
   | _ -> None
 
+let unexpand_asserts expanded =
+  match expanded with
+  | Seq (loc, [ Prim (_, "IF", [ Seq (_, [ ], None) ;
+                                 Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
+                      None) ], None) ->
+      Some (Prim (loc, "ASSERT", [], None))
+  | Seq (loc, [ Seq (_, [ Prim(_, "COMPARE", [], None) ; Prim(_, comparison, [], None) ], None) ;
+                Prim (_, "IF", [ Seq (_, [ ], None) ;
+                                 Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
+                      None) ], None) ->
+      Some (Prim (loc, "ASSERT_CMP" ^ comparison, [], None))
+  | Seq (loc, [ Prim (_, comparison, [], None) ;
+                Prim (_, "IF", [ Seq (_, [ ], None) ;
+                                 Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
+                      None) ], None) ->
+      Some (Prim (loc, "ASSERT_" ^ comparison, [], None))
+  | Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ ], None) ;
+                                      Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
+                      None) ], None) ->
+      Some (Prim (loc, "ASSERT_NONE", [], None))
+  | Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ Prim(_, "FAIL", [], None) ], None) ;
+                                      Seq (_, [ ], None)],
+                      None) ], None) ->
+      Some (Prim (loc, "ASSERT_SOME", [], None))
+  | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ ], None) ;
+                                      Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
+                      None) ], None) ->
+      Some (Prim (loc, "ASSERT_LEFT", [], None))
+  | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Prim(_, "FAIL", [], None) ], None) ;
+                                      Seq (_, [ ], None) ],
+                      None) ], None) ->
+      Some (Prim (loc, "ASSERT_RIGHT", [], None))
+  | _ -> None
+
+
+let unexpand_if_some = function
+  | Seq (loc, [ Prim (_, "IF_NONE", [ left ; right ], None) ], None) ->
+      Some (Prim (loc, "IF_SOME", [ right ; left ], None))
+  | _ -> None
+
+let unexpand_if_right = function
+  | Seq (loc, [ Prim (_, "IF_LEFT", [ left ; right ], None) ], None) ->
+      Some (Prim (loc, "IF_RIGHT", [ right ; left ], None))
+  | _ -> None
+
 let unexpand original =
   let try_expansions unexpanders =
     match
@@ -662,11 +754,14 @@ let unexpand original =
     | None -> original
     | Some rewritten -> rewritten in
   try_expansions
-    [ unexpand_caddadr ;
+    [ unexpand_asserts ;
+      unexpand_caddadr ;
       unexpand_set_caddadr ;
       unexpand_map_caddadr ;
       unexpand_dxiiivp ;
       unexpand_paaiair ;
       unexpand_unpaaiair ;
       unexpand_duuuuup ;
-      unexpand_compare ]
+      unexpand_compare ;
+      unexpand_if_some ;
+      unexpand_if_right ]

src/client/embedded/alpha/michelson_macros.mli

@@ -18,7 +18,10 @@ val expand_dxiiivp : node -> node option
 val expand_paaiair : node -> node option
 val expand_duuuuup : node -> node option
 val expand_compare : node -> node option
+val expand_asserts : node -> node option
 val expand_unpaaiair : node -> node option
+val expand_if_some : node -> node option
+val expand_if_right : node -> node option
 
 open Script
 
@@ -31,4 +34,7 @@ val unexpand_dxiiivp : expr -> expr option
 val unexpand_paaiair : expr -> expr option
 val unexpand_duuuuup : expr -> expr option
 val unexpand_compare : expr -> expr option
+val unexpand_asserts : expr -> expr option
 val unexpand_unpaaiair : expr -> expr option
+val unexpand_if_some : expr -> expr option
+val unexpand_if_right : expr -> expr option

src/proto/alpha/docs/language.md

@@ -842,6 +842,16 @@ constants as is, concatenate them and use them as keys.
         > IF_NONE ; C / (None) : S   =>    bt ; C / S
         > IF_NONE ; C / (Some a) : S    =>    bf ; C / a : S
 
+   * `IF_SOME bt bf`:
+     Inspect an optional value.
+
+        :: 'a? : 'S   ->   'b : 'S
+           iff   bt :: [ 'a : 'S -> 'b : 'S]
+                 bf :: [ 'S -> 'b : 'S]
+
+        > IF_SOME ; C / (Some a) : S    =>    bt ; C / a : S
+        > IF_SOME ; C / (None) : S   =>    bf ; C / S
+
 
 ### Operations on unions
 
@@ -869,6 +879,17 @@ constants as is, concatenate them and use them as keys.
         > IF_LEFT ; C / (Left a) : S    =>    bt ; C / a : S
         > IF_LEFT ; C / (Right b) : S   =>    bf ; C / b : S
 
+   * `IF_RIGHT bt bf`:
+     Inspect an optional value.
+
+        :: or 'a 'b : 'S   ->   'c : 'S
+           iff   bt :: [ 'b : 'S -> 'c : 'S]
+                 bf :: [ 'a : 'S -> 'c : 'S]
+
+        > IF_LEFT ; C / (Right b) : S   =>    bt ; C / b : S
+        > IF_RIGHT ; C / (Left a) : S    =>    bf ; C / a : S
+
+
 ### Operations on lists
 
    * `CONS`:
@@ -1110,6 +1131,41 @@ for under/overflows.
 
         :: key : key : 'S   ->   int : 'S
 
+### Assertion operations
+
+All assertion operations are syntactic sugar for conditionals
+with a `FAIL` instruction in the appropriate branch.
+When possible, use them to increase clarity about illegal states.
+
+   * `ASSERT`:
+
+        > IF {} {FAIL}
+
+   * `ASSERT_{EQ|NEQ|LT|LE|GT|GE}`:
+
+        > ASSERT_(\op) => IF(\op) {} {FAIL}
+
+   * `ASSERT_CMP{EQ|NEQ|LT|LE|GT|GE}`:
+
+        > ASSERT_CMP(\op) => IFCMP(\op) {} {FAIL}
+
+   * `ASSERT_NONE`:
+     Equivalent to ``.
+
+        > ASSERT_NONE => IF_NONE {} {FAIL}
+
+   * `ASSERT_SOME`:
+     Equivalent to `IF_NONE {FAIL} {}`.
+
+        > ASSERT_NONE => IF_NONE {FAIL} {}
+
+   * `ASSERT_LEFT`:
+
+        > ASSERT_LEFT => IF_LEFT {} {FAIL}
+
+   * `ASSERT_RIGHT`:
+
+        > ASSERT_RIGHT => IF_LEFT {FAIL} {}
 
 VIII - Concrete syntax
 ----------------------

test/contracts/assert.tz

@@ -0,0 +1,4 @@
+parameter bool;
+storage unit;
+return unit;
+code {CAR; ASSERT; UNIT; UNIT; PAIR}

test/contracts/assert_cmpeq.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPEQ; UNIT; DUP; PAIR}

test/contracts/assert_cmpge.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGE; UNIT; DUP; PAIR}

test/contracts/assert_cmpgt.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGT; UNIT; DUP; PAIR}

test/contracts/assert_cmple.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLE; UNIT; DUP; PAIR}

test/contracts/assert_cmplt.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLT; UNIT; DUP; PAIR}

test/contracts/assert_cmpneq.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPNEQ; UNIT; DUP; PAIR}

test/contracts/assert_eq.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_EQ; UNIT; DUP; PAIR}

test/contracts/assert_ge.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GE; UNIT; DUP; PAIR}

test/contracts/assert_gt.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GT; UNIT; DUP; PAIR}

test/contracts/assert_le.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LE; UNIT; DUP; PAIR}

test/contracts/assert_lt.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LT; UNIT; DUP; PAIR}

test/contracts/assert_neq.tz

@@ -0,0 +1,4 @@
+parameter (pair int int);
+storage unit;
+return unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_NEQ; UNIT; DUP; PAIR}

test/contracts/if_some.tz

@@ -0,0 +1,4 @@
+parameter (option string);
+return string;
+storage unit;
+code { CAR; IF_SOME {} {PUSH string ""}; UNIT; SWAP; PAIR}

test/contracts/set_car.tz

@@ -0,0 +1,4 @@
+parameter string;
+storage (pair string nat);
+return (pair string nat);
+code {DUP; CDR; DIP{CAR}; SET_CAR; DUP; PAIR};

test/contracts/set_cdr.tz

@@ -0,0 +1,4 @@
+parameter nat;
+storage (pair string nat);
+return (pair string nat);
+code {DUP; CDR; DIP{CAR}; SET_CDR; DUP; PAIR};

test/proto_alpha/Makefile

@@ -114,3 +114,21 @@ test-vote: ${LIB} ${TEST_VOTE_IMPLS:.ml=.cmx}
 clean::
 	rm -f test-vote
 
+############################################################################
+## Michelson Parser
+
+.PHONY: run-test-michelson-parser
+run-test-michelson-parser:
+	@echo
+	./test-michelson-parser
+
+TEST_MICHELSON_PARSER_IMPLS := \
+  proto_alpha_helpers.ml \
+  test_michelson_parser.ml
+
+test-michelson-parser: ${LIB} ${TEST_MICHELSON_PARSER_IMPLS:.ml=.cmx}
+	@echo COMPILE $(notdir $@)
+	@${OCAMLOPT} -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^
+
+clean::
+	rm -f test-michelson-parser

test/proto_alpha/test_michelson_parser.ml

@@ -0,0 +1,316 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2016.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Client_embedded_proto_alpha
+open Tezos_context.Script
+open Client_alpha
+
+module Helpers = Proto_alpha_helpers
+module Assert = Helpers.Assert
+
+open Script_located_ir
+
+let zero_loc = { start=point_zero;
+                 stop=point_zero};;
+
+let assert_identity f x =
+  Assert.equal
+    (f x)
+    x;;
+
+(* Test expansion *)
+Assert.equal (Michelson_macros.expand (Prim (zero_loc, "CAAR", [], None)))
+  (Seq (zero_loc,
+        [(Prim (zero_loc, "CAR", [], None));
+         (Prim (zero_loc, "CAR", [], None)) ],
+        None));;
+
+Assert.equal (Michelson_macros.expand (Prim (zero_loc, "CAAR", [], Some "annot")))
+  (Seq (zero_loc,
+        [(Prim (zero_loc, "CAR", [], None));
+         (Prim (zero_loc, "CAR", [], Some "annot")) ],
+        None));;
+
+assert_identity Michelson_macros.expand (Prim (zero_loc, "CAR", [], Some "annot"));;
+
+
+let arg = [ Prim (zero_loc, "CAR", [], Some "annot") ] in
+Assert.equal
+  (Michelson_macros.expand (Prim (zero_loc, "DIP", arg, Some "new_annot")))
+  (Prim (zero_loc, "DIP", arg, Some "new_annot"));
+Assert.equal
+  (Michelson_macros.expand (Prim (zero_loc, "DIIP", arg, None)))
+  (Seq (zero_loc,
+        [ Prim (zero_loc, "DIP",
+                [ (Seq (zero_loc,
+                        [ Prim (zero_loc, "DIP", arg, None) ],
+                        None)) ],
+                None) ],
+        None));
+Assert.equal
+  (Michelson_macros.expand (Prim (zero_loc, "DIIIP", arg, None)))
+  (Seq (zero_loc,
+        [ Prim (zero_loc, "DIP",
+                [ (Seq (zero_loc,
+                        [ Prim (zero_loc,
+                                "DIP",
+                                [ (Seq (zero_loc,
+                                        [ Prim (zero_loc, "DIP", arg, None) ],
+                                        None)) ],
+                                None) ],
+                        None)) ],
+                None) ],
+        None));;
+
+Assert.equal
+  (Michelson_macros.expand (Prim (zero_loc, "DUUP", [], None)))
+  (Seq (zero_loc,
+        [ Prim (zero_loc, "DIP", [ Seq (zero_loc, [ Prim (zero_loc, "DUP", [], None) ], None) ], None) ;
+          Prim (zero_loc, "SWAP", [], None) ], None));;
+
+Assert.equal
+  (Michelson_macros.expand (Prim (zero_loc, "DUUUP", [], None)))
+  (Seq (zero_loc,
+        [ Prim (zero_loc, "DIP",
+                [ Seq (zero_loc, [
+                      Prim (zero_loc, "DIP", [
+                          Seq (zero_loc, [ Prim (zero_loc, "DUP", [], None) ], None)],
+                            None);
+                      Prim (zero_loc, "SWAP", [], None) ],
+                       None) ],
+                None) ;
+          Prim (zero_loc, "SWAP", [], None) ], None));;
+
+let assert_compare_macro prim_name compare_name =
+  Assert.equal
+    (Michelson_macros.expand (Prim (zero_loc, prim_name, [], None)))
+    (Seq (zero_loc,
+          [ Prim (zero_loc, "COMPARE", [], None) ;
+            Prim (zero_loc, compare_name, [], None) ], None));;
+
+let left_branch = Seq(zero_loc, [ Prim(zero_loc, "SWAP", [], None) ], None);;
+let right_branch = Seq(zero_loc, [ ], None);;
+let assert_compare_if_macro prim_name compare_name =
+  Assert.equal
+    (Michelson_macros.expand (Prim (zero_loc,
+                                    prim_name,
+                                    [ left_branch ; right_branch ],
+                                    None)))
+    (Seq (zero_loc, [ Prim(zero_loc, "COMPARE", [], None);
+                      Prim(zero_loc, compare_name, [], None);
+                      Prim (zero_loc, "IF", [ left_branch ; right_branch ], None) ], None)) in
+
+assert_compare_macro "CMPEQ" "EQ";
+assert_compare_macro "CMPNEQ" "NEQ";
+assert_compare_macro "CMPLT" "LT";
+assert_compare_macro "CMPLE" "LE";
+assert_compare_macro "CMPGT" "GT";
+assert_compare_macro "CMPGE" "GE";
+
+assert_compare_if_macro "IFCMPEQ" "EQ";
+assert_compare_if_macro "IFCMPNEQ" "NEQ";
+assert_compare_if_macro "IFCMPLT" "LT";
+assert_compare_if_macro "IFCMPLE" "LE";
+assert_compare_if_macro "IFCMPGT" "GT";
+assert_compare_if_macro "IFCMPGE" "GE";
+Assert.equal (Michelson_macros.expand (Prim (zero_loc, "ASSERT_LEFT", [], None)))
+  (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT",
+                          [ Seq (zero_loc, [ ], None) ;
+                            Seq (zero_loc, [ Prim(zero_loc, "FAIL", [], None) ], None) ],
+                          None) ], None));
+Assert.equal (Michelson_macros.expand (Prim (zero_loc, "ASSERT_RIGHT", [], None)))
+  (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT",
+                          [ Seq (zero_loc, [ Prim(zero_loc, "FAIL", [], None) ], None) ;
+                            Seq (zero_loc, [ ], None) ],
+                          None) ], None));
+Assert.equal (Michelson_macros.expand (Prim (zero_loc, "IF_RIGHT", [ left_branch ; right_branch ], None)))
+  (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT", [ right_branch ; left_branch ], None) ], None));
+Assert.equal (Michelson_macros.expand (Prim (zero_loc, "IF_SOME", [ left_branch ; right_branch ], None)))
+  (Seq (zero_loc, [ Prim (zero_loc, "IF_NONE", [ right_branch ; left_branch ], None) ], None));;
+
+
+assert_identity Michelson_macros.expand (Prim (zero_loc, "PAIR", [], None));;
+
+let expand_unexpand x =
+  Michelson_macros.unexpand (Michelson_macros.expand x);;
+
+assert_identity expand_unexpand (Prim (zero_loc, "PAAAIAIR", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "DIIIP{DROP}", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "SET_CAR", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "SET_CDR", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "DUP", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "DUUP", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "DUUUP", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "DUUUUP", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "DUUUUUP", [], None));
+
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_EQ", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_NEQ", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_LT", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_LE", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_GT", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_GE", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_NONE", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_SOME", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_LEFT", [], None));
+assert_identity expand_unexpand (Prim (zero_loc, "ASSERT_RIGHT", [], None));
+
+assert_identity expand_unexpand (Prim (zero_loc, "IF_RIGHT", [ left_branch ; right_branch], None));
+assert_identity expand_unexpand (Prim (zero_loc, "IF_SOME", [ left_branch ; right_branch], None));
+
+Assert.equal (Michelson_macros.expand (Prim (zero_loc, "PAAIR", [], None)))
+  (Seq (zero_loc,
+        [Prim
+           (zero_loc,
+            "DIP",
+            [Seq (zero_loc, [Prim
+                               (zero_loc, "PAIR", [], None)],
+                  None)],
+            None)],
+        None));;
+
+Assert.equal (Michelson_macros.expand (Prim (zero_loc, "PAAIAIR", [], None)))
+  (Seq (zero_loc, [Prim
+                     (zero_loc,
+                      "DIP",
+                      [Seq
+                         (zero_loc,
+                          [Prim
+                             (zero_loc,
+                              "PAIR", [], None)],
+                          None)],
+                      None);
+                   Prim
+                     (zero_loc,
+                      "PAIR", [], None)],
+        None));;
+
+open Michelson_parser;;
+
+let get_tokens =
+  List.map (fun x -> x.token);;
+
+Assert.equal (get_tokens @@ tokenize @@ "int")
+  [ (Ident "int") ];
+Assert.equal (get_tokens @@ tokenize @@ "100")
+  [ (Int "100") ];
+Assert.equal (get_tokens @@ tokenize @@ "(option int)")
+  [ Open_paren ; Ident "option" ; Ident "int" ; Close_paren ];
+Assert.equal (get_tokens @@ tokenize @@ "DIP { ADD }")
+  [ Ident "DIP" ; Open_brace ; Ident "ADD" ; Close_brace ];
+Assert.equal (get_tokens @@ tokenize @@ "\"hello\"")
+  [ String "hello" ];
+Assert.equal (get_tokens @@ tokenize @@ "parameter int;")
+  [ Ident "parameter" ; Ident "int" ; Semi ];
+Assert.equal (get_tokens @@ tokenize @@ "PUSH string \"abcd\";")
+  [ Ident "PUSH" ; Ident "string" ; String "abcd" ; Semi ];
+Assert.equal (get_tokens @@ tokenize @@ "DROP; SWAP")
+  [ Ident "DROP" ; Semi ; Ident "SWAP" ];
+Assert.equal (get_tokens @@ tokenize @@ "string")
+  [ Ident "string" ]
+
+
+let parse_expr_no_locs str =
+  List.map strip_locations
+  Michelson_parser.(parse_toplevel (tokenize str))
+
+let assert_parses str parsed =
+  Assert.equal (parse_expr_no_locs str) parsed;;
+
+assert_parses "PUSH int 100"
+  [ (Prim ((), "PUSH", [ Prim ((), "int", [], None) ;
+                         Int ((), "100") ], None)) ];
+
+assert_parses "DROP" [ (Prim ((), "DROP", [], None)) ];
+assert_parses "DIP{DROP}"
+  [ Prim ((), "DIP", [ Seq((), [ Prim ((), "DROP", [], None) ], None) ], None) ];
+
+assert_parses "LAMBDA int int {}"
+  [ Prim ((), "LAMBDA", [ Prim ((), "int", [], None) ;
+                          Prim ((), "int", [], None) ;
+                          Seq ((), [ ], None) ], None) ];
+
+assert_parses "LAMBDA @name int int {}"
+  [ Prim ((), "LAMBDA", [ Prim ((), "int", [], None) ;
+                          Prim ((), "int", [], None) ;
+                          Seq ((), [ ], None) ], Some "@name") ];
+
+assert_parses "NIL @annot string; # comment\n"
+  [ Prim ((), "NIL", [ Prim ((), "string", [], None) ], Some "@annot") ];
+
+assert_parses "PUSH (pair bool string) (Pair False \"abc\")"
+  [ Prim ((), "PUSH", [ Prim ((), "pair",
+                              [ Prim ((), "bool", [], None) ;
+                                Prim ((), "string", [], None) ], None) ;
+                        Prim ((), "Pair", 
+                                   [ Prim ((), "False", [], None) ;
+                                     String ((), "abc")], None) ], None) ];
+assert_parses "PUSH (list nat) (List 1 2 3)"
+  [ Prim ((), "PUSH", [ Prim ((), "list",
+                              [ Prim ((), "nat", [], None) ], None) ;
+                        Prim ((), "List",
+                              [ Int((), "1");
+                                Int ((), "2");
+                                Int ((), "3")],
+                              None) ], None) ];
+assert_parses "PUSH (lambda nat nat) {}"
+  [ Prim ((), "PUSH", [ Prim ((), "lambda",
+                              [ Prim ((), "nat", [], None);
+                                Prim ((), "nat", [], None)], None) ;
+                        Seq((), [], None)],
+                        None) ];
+assert_parses "PUSH key \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\""
+  [ Prim ((), "PUSH", [ Prim ((), "key", [], None) ;
+                        String ((),"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") ],
+          None) ];
+assert_parses "PUSH (map int bool) (Map (Item 100 False))"
+  [ Prim ((), "PUSH", [ Prim ((), "map",
+                              [ Prim((), "int", [], None);
+                                Prim((), "bool", [], None)], None) ;
+                        Prim ((), "Map",
+                              [Prim ((), "Item",
+                                     [Int ((), "100");
+                                      Prim ((), "False", [], None)], None)], None) ],
+          None) ];
+assert_parses
+  "parameter int; \
+return int; \ 
+storage unit; \
+code {}"
+  [ Prim ((), "parameter", [ Prim((), "int", [], None) ], None);
+    Prim ((), "return", [ Prim((), "int", [], None) ], None);
+    Prim ((), "storage", [ Prim((), "unit", [], None) ], None);
+    Prim ((), "code", [ Seq((), [], None) ], None)];
+assert_parses
+  "parameter int; \
+   storage unit; \
+   return int; \
+   code {CAR; PUSH int 1; ADD; UNIT; SWAP; PAIR};"
+  [ Prim ((), "parameter", [ Prim((), "int", [], None) ], None);
+    Prim ((), "storage", [ Prim((), "unit", [], None) ], None);
+    Prim ((), "return", [ Prim((), "int", [], None) ], None);
+    Prim ((), "code", [ Seq((), [ Prim ((), "CAR", [], None) ;
+                                  Prim ((), "PUSH", [ Prim((), "int", [], None) ;
+                                                      Int ((), "1")], None) ;
+                                  Prim ((), "ADD", [], None) ;
+                                  Prim ((), "UNIT", [], None) ;
+                                  Prim ((), "SWAP", [], None) ;
+                                  Prim ((), "PAIR", [], None)], None) ], None)];
+assert_parses
+  "code {DUP @test; DROP}"
+  [ Prim ((), "code", [Seq ((), [ Prim ((), "DUP", [], Some "@test");
+                                  Prim ((), "DROP", [], None)], None)], None) ];
+assert_parses
+  "IF {CAR} {CDR}"
+  [ Prim ((), "IF", [ Seq ((), [ Prim ((), "CAR", [], None) ], None); 
+                      Seq ((), [ Prim ((), "CDR", [], None) ], None) ], None) ];
+assert_parses
+  "IF_NONE {FAIL} {}"
+  [ Prim ((), "IF_NONE", [ Seq ((), [ Prim ((), "FAIL", [], None) ], None); 
+                           Seq ((), [ ], None) ], None) ];

test/test_contracts.sh

@@ -196,7 +196,76 @@ assert_output $CONTRACT_PATH/first.tz Unit '(List 4)' '4'
 assert_output $CONTRACT_PATH/hash_string.tz Unit '"abcdefg"' '"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF"'
 assert_output $CONTRACT_PATH/hash_string.tz Unit '"12345"' '"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3"'
 
-# Did the given key sign the string?
+# Test ASSERT
+assert_output $CONTRACT_PATH/assert.tz Unit True Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert.tz on storage Unit and input False
+
+# COMPARE; ASSERT_
+assert_output $CONTRACT_PATH/assert_eq.tz Unit '(Pair -1 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_eq.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_output $CONTRACT_PATH/assert_eq.tz Unit '(Pair -1 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_eq.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_output $CONTRACT_PATH/assert_neq.tz Unit '(Pair 0 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_neq.tz on storage Unit and input '(Pair -1 -1)'
+
+assert_output $CONTRACT_PATH/assert_lt.tz Unit '(Pair -1 0)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_lt.tz on storage Unit and input '(Pair 0 -1)'
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_lt.tz on storage Unit and input '(Pair 0 0)'
+
+assert_output $CONTRACT_PATH/assert_le.tz Unit '(Pair 0 0)' Unit
+assert_output $CONTRACT_PATH/assert_le.tz Unit '(Pair -1 0)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_le.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_output $CONTRACT_PATH/assert_gt.tz Unit '(Pair 0 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_gt.tz on storage Unit and input '(Pair -1 0)'
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_gt.tz on storage Unit and input '(Pair 0 0)'
+
+assert_output $CONTRACT_PATH/assert_ge.tz Unit '(Pair 0 0)' Unit
+assert_output $CONTRACT_PATH/assert_ge.tz Unit '(Pair 0 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_ge.tz on storage Unit and input '(Pair -1 0)'
+
+# ASSERT_CMP
+assert_output $CONTRACT_PATH/assert_cmpeq.tz Unit '(Pair -1 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpeq.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_output $CONTRACT_PATH/assert_cmpeq.tz Unit '(Pair -1 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpeq.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_output $CONTRACT_PATH/assert_cmpneq.tz Unit '(Pair 0 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpneq.tz on storage Unit and input '(Pair -1 -1)'
+
+assert_output $CONTRACT_PATH/assert_cmplt.tz Unit '(Pair -1 0)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmplt.tz on storage Unit and input '(Pair 0 -1)'
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmplt.tz on storage Unit and input '(Pair 0 0)'
+
+assert_output $CONTRACT_PATH/assert_cmple.tz Unit '(Pair 0 0)' Unit
+assert_output $CONTRACT_PATH/assert_cmple.tz Unit '(Pair -1 0)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmple.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_output $CONTRACT_PATH/assert_cmpgt.tz Unit '(Pair 0 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpgt.tz on storage Unit and input '(Pair -1 0)'
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpgt.tz on storage Unit and input '(Pair 0 0)'
+
+assert_output $CONTRACT_PATH/assert_cmpge.tz Unit '(Pair 0 0)' Unit
+assert_output $CONTRACT_PATH/assert_cmpge.tz Unit '(Pair 0 -1)' Unit
+assert_fails ${TZCLIENT} run program $CONTRACT_PATH/assert_cmpge.tz on storage Unit and input '(Pair -1 0)'
+
+# IF_SOME
+assert_output $CONTRACT_PATH/if_some.tz Unit '(Some "hello")' '"hello"'
+assert_output $CONTRACT_PATH/if_some.tz Unit 'None' '""'
+
+# Tests the SET_CAR and SET_CDR instructions
+assert_output  $CONTRACT_PATH/set_car.tz '(Pair "hello" 0)' '"world"' '(Pair "world" 0)'
+assert_output  $CONTRACT_PATH/set_car.tz '(Pair "hello" 0)' '"abc"' '(Pair "abc" 0)'
+assert_output  $CONTRACT_PATH/set_car.tz '(Pair "hello" 0)' '""' '(Pair "" 0)'
+
+assert_output  $CONTRACT_PATH/set_cdr.tz '(Pair "hello" 0)' '1' '(Pair "hello" 1)'
+assert_output  $CONTRACT_PATH/set_cdr.tz '(Pair "hello" 500)' '3' '(Pair "hello" 3)'
+assert_output  $CONTRACT_PATH/set_cdr.tz '(Pair "hello" 7)' '100' '(Pair "hello" 100)'
+
+# Did the given key sign the string? (key is bootstrap1)
 assert_output $CONTRACT_PATH/check_signature.tz \
 '(Pair "26981d372a7b3866621bf79713d249197fe6d518ef702fa65738e1715bde9da54df04fefbcc84287ecaa9f74ad9296462731aa24bbcece63c6bf73a8f5752309" "hello")' \
 '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' True