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

@@ -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

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
 
 

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

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

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)
 

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 }});
+};