bugfix: repro and fix for unimplemented region ops (#4270)

Looks like some region operations were NYI. This PR fixes the implementation of load/store for `Int8`, `Int16` and `Float`, adding a test of all operations.
dfinity · Nov 10, 2023 · b58592b · b58592b
1 parent d80da65
commit b58592b
Show file tree

Hide file tree

Showing 12 changed files with 498 additions and 47 deletions.
diff --git a/Changelog.md b/Changelog.md
@@ -15,6 +15,7 @@
     *  The actor literal, `actor <exp>`, will trap if the binary representation of
     of the textually encoded principal `<exp>` contains strictly more than 29 bytes.
 
+  * bugfix: fully implement `Region.loadXXX/storeXXX` for `Int8`, `Int16` and `Float`.
 
 ## 0.10.1 (2023-10-16)
 

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
@@ -10656,34 +10656,34 @@ and compile_prim_invocation (env : E.t) ae p es at =
     compile_exp_as env ae SR.Vanilla e2 ^^
     Region.store_blob env
 
-  | OtherPrim ("regionLoadNat8"), [e0; e1] ->
+  | OtherPrim (("regionLoadNat8" | "regionLoadInt8" as p)), [e0; e1] ->
     SR.Vanilla,
     compile_exp_as env ae SR.Vanilla e0 ^^
     compile_exp_as env ae SR.UnboxedWord64 e1 ^^
     Region.load_word8 env ^^
-    TaggedSmallWord.msb_adjust Type.Nat8
+    TaggedSmallWord.msb_adjust Type.(if p = "regionLoadNat8" then Nat8 else Int8)
 
-  | OtherPrim ("regionStoreNat8"), [e0; e1; e2] ->
+  | OtherPrim (("regionStoreNat8" | "regionStoreInt8") as p), [e0; e1; e2] ->
     SR.unit,
     compile_exp_as env ae SR.Vanilla e0 ^^
     compile_exp_as env ae SR.UnboxedWord64 e1 ^^
     compile_exp_as env ae SR.Vanilla e2 ^^
-    TaggedSmallWord.lsb_adjust Type.Nat8 ^^
+    TaggedSmallWord.lsb_adjust Type.(if p = "regionStoreNat8" then Nat8 else Int8) ^^
     Region.store_word8 env
 
-  | OtherPrim ("regionLoadNat16"), [e0; e1] ->
+  | OtherPrim (("regionLoadNat16" | "regionLoadInt16") as p), [e0; e1] ->
     SR.Vanilla,
     compile_exp_as env ae SR.Vanilla e0 ^^
     compile_exp_as env ae SR.UnboxedWord64 e1 ^^
     Region.load_word16 env ^^
-    TaggedSmallWord.msb_adjust Type.Nat16
+    TaggedSmallWord.msb_adjust Type.(if p = "regionLoadNat16" then Nat16 else Int16)
 
-  | OtherPrim ("regionStoreNat16"), [e0; e1; e2] ->
+  | OtherPrim (("regionStoreNat16" | "regionStoreInt16") as p), [e0; e1; e2] ->
     SR.unit,
     compile_exp_as env ae SR.Vanilla e0 ^^
     compile_exp_as env ae SR.UnboxedWord64 e1 ^^
     compile_exp_as env ae SR.Vanilla e2 ^^
-    TaggedSmallWord.lsb_adjust Type.Nat16 ^^
+    TaggedSmallWord.lsb_adjust Type.(if p = "regionStoreNat16" then Nat16 else Int16) ^^
     Region.store_word16 env
 
   | OtherPrim ("regionLoadNat32" | "regionLoadInt32"), [e0; e1] ->
@@ -10712,13 +10712,13 @@ and compile_prim_invocation (env : E.t) ae p es at =
     compile_exp_as env ae SR.UnboxedWord64 e2 ^^
     Region.store_word64 env
 
-  | OtherPrim ("regionLoadFloat64"), [e0; e1] ->
+  | OtherPrim ("regionLoadFloat"), [e0; e1] ->
     SR.UnboxedFloat64,
     compile_exp_as env ae SR.Vanilla e0 ^^
     compile_exp_as env ae SR.UnboxedWord64 e1 ^^
     Region.load_float64 env
 
-  | OtherPrim ("regionStoreFloat64"), [e0; e1; e2] ->
+  | OtherPrim ("regionStoreFloat"), [e0; e1; e2] ->
     SR.unit,
     compile_exp_as env ae SR.Vanilla e0 ^^
     compile_exp_as env ae SR.UnboxedWord64 e1 ^^
@@ -10847,55 +10847,32 @@ and compile_prim_invocation (env : E.t) ae p es at =
     compile_exp_as env ae SR.UnboxedWord32 e2 ^^
     StableMemoryInterface.store_word32 env
 
-  | OtherPrim "stableMemoryLoadNat8", [e] ->
+  | OtherPrim (("stableMemoryLoadNat8" | "stableMemoryLoadInt8") as p), [e] ->
     SR.Vanilla,
     compile_exp_as env ae SR.UnboxedWord64 e ^^
     StableMemoryInterface.load_word8 env ^^
-    TaggedSmallWord.msb_adjust Type.Nat8
-
-  | OtherPrim "stableMemoryLoadInt8", [e] ->
-    SR.Vanilla,
-    compile_exp_as env ae SR.UnboxedWord64 e ^^
-    StableMemoryInterface.load_word8 env
-    ^^
-    TaggedSmallWord.msb_adjust Type.Int8
+    TaggedSmallWord.msb_adjust Type.(if p = "stableMemoryLoadNat8" then Nat8 else Int8)
 
   (* Other prims, binary *)
 
-  | OtherPrim "stableMemoryStoreNat8", [e1; e2] ->
-    SR.unit,
-    compile_exp_as env ae SR.UnboxedWord64 e1 ^^
-    compile_exp_as env ae SR.Vanilla e2 ^^ TaggedSmallWord.lsb_adjust Type.Nat8 ^^
-    StableMemoryInterface.store_word8 env
-
-  | OtherPrim "stableMemoryStoreInt8", [e1; e2] ->
+  | OtherPrim (("stableMemoryStoreNat8" | "stableMemoryStoreInt8") as p), [e1; e2] ->
     SR.unit,
     compile_exp_as env ae SR.UnboxedWord64 e1 ^^
-    compile_exp_as env ae SR.Vanilla e2 ^^ TaggedSmallWord.lsb_adjust Type.Int8 ^^
+    compile_exp_as env ae SR.Vanilla e2 ^^
+    TaggedSmallWord.lsb_adjust Type.(if p = "stableMemoryStoreNat8" then Nat8 else Int8) ^^
     StableMemoryInterface.store_word8 env
 
-  | OtherPrim "stableMemoryLoadNat16", [e] ->
-    SR.Vanilla,
-    compile_exp_as env ae SR.UnboxedWord64 e ^^
-    StableMemoryInterface.load_word16 env ^^
-    TaggedSmallWord.msb_adjust Type.Nat16
-
-  | OtherPrim "stableMemoryLoadInt16", [e] ->
+  | OtherPrim (("stableMemoryLoadNat16" | "stableMemoryLoadInt16") as p), [e] ->
     SR.Vanilla,
     compile_exp_as env ae SR.UnboxedWord64 e ^^
     StableMemoryInterface.load_word16 env ^^
-    TaggedSmallWord.msb_adjust Type.Int16
+    TaggedSmallWord.msb_adjust Type.(if p = "stableMemoryLoadNat16" then Nat16 else Int16)
 
-  | OtherPrim "stableMemoryStoreNat16", [e1; e2] ->
+  | OtherPrim (("stableMemoryStoreNat16" | "stableMemoryStoreInt16") as p), [e1; e2] ->
     SR.unit,
     compile_exp_as env ae SR.UnboxedWord64 e1 ^^
-    compile_exp_as env ae SR.Vanilla e2 ^^ TaggedSmallWord.lsb_adjust Type.Nat16 ^^
-    StableMemoryInterface.store_word16 env
-
-  | OtherPrim "stableMemoryStoreInt16", [e1; e2] ->
-    SR.unit,
-    compile_exp_as env ae SR.UnboxedWord64 e1 ^^
-    compile_exp_as env ae SR.Vanilla e2 ^^ TaggedSmallWord.lsb_adjust Type.Int16 ^^
+    compile_exp_as env ae SR.Vanilla e2 ^^
+    TaggedSmallWord.lsb_adjust Type.(if p = "stableMemoryStoreNat16" then Nat16 else Int16) ^^
     StableMemoryInterface.store_word16 env
 
   | OtherPrim ("stableMemoryLoadNat64" | "stableMemoryLoadInt64"), [e] ->

diff --git a/test/run-drun/ok/region-test.drun-run.ok b/test/run-drun/ok/region-test.drun-run.ok
@@ -0,0 +1,12 @@
+ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
+debug.print: Nat8
+debug.print: Nat16
+debug.print: Nat32
+debug.print: Nat64
+debug.print: Int8
+debug.print: Int16
+debug.print: Int32
+debug.print: Int64
+debug.print: Float
+debug.print: Blob
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: Done (rolling back changes with trap)
diff --git a/test/run-drun/ok/region-test.tc.ok b/test/run-drun/ok/region-test.tc.ok
@@ -0,0 +1,12 @@
+region-test.mo:5.5-5.6: warning [M0145], this pattern of type
+  Nat64
+does not cover value
+  1 or 2 or _
+region-test.mo:6.5-6.7: warning [M0145], this pattern of type
+  Nat
+does not cover value
+  0 or 1 or _
+region-test.mo:7.5-7.6: warning [M0145], this pattern of type
+  Nat64
+does not cover value
+  1 or 2 or _
diff --git a/test/run-drun/ok/stable-mem-big-blob.drun-run.ok b/test/run-drun/ok/stable-mem-big-blob.drun-run.ok
@@ -1,4 +1,4 @@
 ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
 debug.print: 255
 debug.print: ok
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at stable-mem-big-blob.mo:18.3-18.15
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at stable-mem-big-blob.mo:17.3-17.15
diff --git a/test/run-drun/ok/stable-mem-big-blob.tc.ok b/test/run-drun/ok/stable-mem-big-blob.tc.ok
@@ -1,4 +1,4 @@
-stable-mem-big-blob.mo:6.7-6.8: warning [M0145], this pattern of type
+stable-mem-big-blob.mo:5.7-5.8: warning [M0145], this pattern of type
   Nat64
 does not cover value
   1 or 2 or _
diff --git a/test/run-drun/ok/stable-memory-test.drun-run.ok b/test/run-drun/ok/stable-memory-test.drun-run.ok
@@ -0,0 +1,12 @@
+ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
+debug.print: Nat8
+debug.print: Nat16
+debug.print: Nat32
+debug.print: Nat64
+debug.print: Int8
+debug.print: Int16
+debug.print: Int32
+debug.print: Int64
+debug.print: Float
+debug.print: Blob
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: Done (rolling back changes with trap)
diff --git a/test/run-drun/ok/stable-memory-test.tc.ok b/test/run-drun/ok/stable-memory-test.tc.ok
@@ -0,0 +1,8 @@
+stable-memory-test.mo:4.5-4.6: warning [M0145], this pattern of type
+  Nat64
+does not cover value
+  1 or 2 or _
+stable-memory-test.mo:5.5-5.6: warning [M0145], this pattern of type
+  Nat64
+does not cover value
+  1 or 2 or _