From 0ed535400e22a552b92b79d430ae619ec9b22d1f Mon Sep 17 00:00:00 2001
From: Gabor Greif <ggreif@gmail.com>
Date: Thu, 12 Sep 2019 15:40:26 +0200
Subject: [PATCH] Parse enclosing (Pos|Neg)Op around numeric literals as sign
 (#638)

* Fix #505 in the parser by treating the innermost negation (also `+`) operator
as a sign. The same idea is applied to expressions and patterns.
---
 src/as_frontend/parser.mly            | 14 ++++++--
 src/as_frontend/typing.ml             |  8 ++---
 src/as_values/value.ml                |  4 +++
 test/fail/ok/pat-subtyping-fail.tc.ok | 48 ++++++++++++++++++++-------
 test/random/Main.hs                   |  7 +---
 test/run/neg-boundary.as              | 24 ++++++++++++++
 6 files changed, 81 insertions(+), 24 deletions(-)
 create mode 100644 test/run/neg-boundary.as

diff --git a/src/as_frontend/parser.mly b/src/as_frontend/parser.mly
index ad1d61546f2..2881625e76f 100644
--- a/src/as_frontend/parser.mly
+++ b/src/as_frontend/parser.mly
@@ -398,7 +398,12 @@ exp_un(B) :
   | QUEST e=exp_un(ob)
     { OptE(e) @? at $sloc }
   | op=unop e=exp_un(ob)
-    { UnE(ref Type.Pre, op, e) @? at $sloc }
+    { match op, e.it with
+      | (PosOp | NegOp), LitE {contents = PreLit (s, Type.Nat)} ->
+        let signed = match op with NegOp -> "-" ^ s | _ -> "+" ^ s in
+        LitE(ref (PreLit (signed, Type.Int))) @? at $sloc
+      | _ -> UnE(ref Type.Pre, op, e) @? at $sloc
+    }
   | op=unassign e=exp_un(ob)
     { assign_op e (fun e' -> UnE(ref Type.Pre, op, e') @? at $sloc) (at $sloc) }
   | NOT e=exp_un(ob)
@@ -540,7 +545,12 @@ pat_un :
   | QUEST p=pat_un
     { OptP(p) @! at $sloc }
   | op=unop l=lit
-    { SignP(op, ref l) @! at $sloc }
+    { match op, l with
+      | (PosOp | NegOp), PreLit (s, Type.Nat) ->
+        let signed = match op with NegOp -> "-" ^ s | _ -> "+" ^ s in
+        LitP(ref (PreLit (signed, Type.Int))) @! at $sloc
+      | _ -> SignP(op, ref l) @! at $sloc
+    }
 
 pat_bin :
   | p=pat_un
diff --git a/src/as_frontend/typing.ml b/src/as_frontend/typing.ml
index 29f36a5d861..583efb19bc8 100644
--- a/src/as_frontend/typing.ml
+++ b/src/as_frontend/typing.ml
@@ -342,10 +342,10 @@ let check_int8 env = check_lit_val env T.Int8 Value.Int_8.of_string
 let check_int16 env = check_lit_val env T.Int16 Value.Int_16.of_string
 let check_int32 env = check_lit_val env T.Int32 Value.Int_32.of_string
 let check_int64 env = check_lit_val env T.Int64 Value.Int_64.of_string
-let check_word8 env = check_lit_val env T.Word8 Value.Word8.of_string_u
-let check_word16 env = check_lit_val env T.Word16 Value.Word16.of_string_u
-let check_word32 env = check_lit_val env T.Word32 Value.Word32.of_string_u
-let check_word64 env = check_lit_val env T.Word64 Value.Word64.of_string_u
+let check_word8 env = check_lit_val env T.Word8 Value.Word8.of_string_s
+let check_word16 env = check_lit_val env T.Word16 Value.Word16.of_string_s
+let check_word32 env = check_lit_val env T.Word32 Value.Word32.of_string_s
+let check_word64 env = check_lit_val env T.Word64 Value.Word64.of_string_s
 let check_float env = check_lit_val env T.Float Value.Float.of_string
 
 
diff --git a/src/as_values/value.ml b/src/as_values/value.ml
index 8fc15121299..3443b7c40e7 100644
--- a/src/as_values/value.ml
+++ b/src/as_values/value.ml
@@ -105,6 +105,10 @@ struct
     let s' = dig ^ (if i = 4 then "_" else "") ^ s in
     to_pretty_string' (WasmInt.div_u w base) (i mod 4 + 1) s'
   let to_string = to_pretty_string
+  let of_string_s s =
+    if String.length s > 0 && String.get s 0 = '-'
+    then neg (of_string_u (String.sub s 1 (String.length s - 1)))
+    else of_string_u s
 end
 
 module Int32Rep = struct include Int32 let bitwidth = 32 end
diff --git a/test/fail/ok/pat-subtyping-fail.tc.ok b/test/fail/ok/pat-subtyping-fail.tc.ok
index 227bfbe1c5c..53da2a8563c 100644
--- a/test/fail/ok/pat-subtyping-fail.tc.ok
+++ b/test/fail/ok/pat-subtyping-fail.tc.ok
@@ -1,28 +1,52 @@
 pat-subtyping-fail.as:123.3-123.15: warning, this case is never reached
 pat-subtyping-fail.as:124.3-124.12: warning, this case is never reached
-pat-subtyping-fail.as:4.9-4.11: type error, operator cannot consume expected type
+pat-subtyping-fail.as:4.9-4.11: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:8.9-8.11: type error, operator cannot consume expected type
+pat-subtyping-fail.as:8.9-8.11: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:13.13-13.15: type error, operator cannot consume expected type
+pat-subtyping-fail.as:13.13-13.15: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:17.18-17.20: type error, operator cannot consume expected type
+pat-subtyping-fail.as:17.18-17.20: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:22.21-22.23: type error, operator cannot consume expected type
+pat-subtyping-fail.as:22.21-22.23: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:26.26-26.28: type error, operator cannot consume expected type
+pat-subtyping-fail.as:26.26-26.28: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:31.11-31.13: type error, operator cannot consume expected type
+pat-subtyping-fail.as:31.11-31.13: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:35.11-35.13: type error, operator cannot consume expected type
+pat-subtyping-fail.as:35.11-35.13: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:39.11-39.13: type error, operator cannot consume expected type
+pat-subtyping-fail.as:39.11-39.13: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:44.12-44.14: type error, operator cannot consume expected type
+pat-subtyping-fail.as:44.12-44.14: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:48.12-48.14: type error, operator cannot consume expected type
+pat-subtyping-fail.as:48.12-48.14: type error, literal of type
+  Int
+does not have expected type
   Nat
-pat-subtyping-fail.as:52.12-52.14: type error, operator cannot consume expected type
+pat-subtyping-fail.as:52.12-52.14: type error, literal of type
+  Int
+does not have expected type
   Nat
 pat-subtyping-fail.as:57.9-57.16: type error, pattern of type
   Nat
diff --git a/test/random/Main.hs b/test/random/Main.hs
index 439782dfab7..5f6c4504f14 100644
--- a/test/random/Main.hs
+++ b/test/random/Main.hs
@@ -676,14 +676,9 @@ instance Literal Integer
 instance Literal Natural
 instance Literal (BitLimited n Natural)
 instance KnownNat bits => Literal (BitLimited bits Integer) where
-  -- compensate for https://github.com/dfinity-lab/actorscript/issues/505
-  literal (evalN -> n) = if buggy n then "intToInt" <> bitWidth pr <> "(" <> show n <> ")"
-                         else if n < 0
+  literal (evalN -> n) = if n < 0
                          then "(" <> show n <> ")"
                          else show n
-    where buggy n = n == - 2 ^ (numbits - 1)
-          numbits = natVal pr
-          pr = Proxy @bits
 instance KnownNat bits => Literal (BitLimited bits Word) where
   literal n = show . fromJust $ trapWord (natVal (Proxy @bits)) (evalN n)
 
diff --git a/test/run/neg-boundary.as b/test/run/neg-boundary.as
new file mode 100644
index 00000000000..81c605db079
--- /dev/null
+++ b/test/run/neg-boundary.as
@@ -0,0 +1,24 @@
+let _ : Int8 = -128;
+let _ : Int16 = -32768;
+let _ : Int32 = -2_147_483_648;
+let _ : Int64 = -9_223_372_036_854_775_808;
+{
+    assert (switch (-128 : Int8) { case (-128) { true }; case _ { false }});
+    func foo(i : Int8) = assert (switch i { case (-128) { true }; case _ { false }});
+    func bar(i : Int8) = assert (switch i { case (-128 : Int8) { true }; case _ { false }});
+};
+{
+    assert (switch (-32768 : Int16) { case (-32768) { true }; case _ { false }});
+    func foo(i : Int16) = assert (switch i { case (-32768) { true }; case _ { false }});
+    func bar(i : Int16) = assert (switch i { case (-32768 : Int16) { true }; case _ { false }});
+};
+{
+    assert (switch (-2_147_483_648 : Int32) { case (-2_147_483_648) { true }; case _ { false }});
+    func foo(i : Int32) = assert (switch i { case (-2_147_483_648) { true }; case _ { false }});
+    func bar(i : Int32) = assert (switch i { case (-2_147_483_648 : Int32) { true }; case _ { false }});
+};
+{
+    assert (switch (-9_223_372_036_854_775_808 : Int64) { case (-9_223_372_036_854_775_808) { true }; case _ { false }});
+    func foo(i : Int64) = assert (switch i { case (-9_223_372_036_854_775_808) { true }; case _ { false }});
+    func bar(i : Int64) = assert (switch i { case (-9_223_372_036_854_775_808 : Int64) { true }; case _ { false }});
+};