@grain/stdlib 0.5.12 → 0.6.0

package/runtime/compare.gr

@@ -1,29 +1,34 @@
-/* grainc-flags --no-pervasives */
+@noPervasives
+module Compare
 
-import WasmI32, {
-  eq as (==),
-  ne as (!=),
-  and as (&),
-  xor as (^),
-  or as (|),
-  add as (+),
-  sub as (-),
-  mul as (*),
-  ltS as (<),
-  gtS as (>),
+from "runtime/unsafe/wasmi32" include WasmI32
+use WasmI32.{
+  (==),
+  (!=),
+  (&),
+  (^),
+  (|),
+  (+),
+  (-),
+  (*),
+  (<),
+  (>),
   remS as (%),
-  shl as (<<),
-  shrU as (>>>),
-} from "runtime/unsafe/wasmi32"
-import WasmI64 from "runtime/unsafe/wasmi64"
-import Memory from "runtime/unsafe/memory"
-import Tags from "runtime/unsafe/tags"
-import { tagSimpleNumber } from "runtime/dataStructures"
-import { isNumber, cmp as numberCompare } from "runtime/numbers"
+  (<<),
+  (>>>),
+}
+from "runtime/unsafe/wasmi64" include WasmI64
+from "runtime/unsafe/wasmf32" include WasmF32
+from "runtime/unsafe/memory" include Memory
+from "runtime/unsafe/tags" include Tags
+from "runtime/dataStructures" include DataStructures
+use DataStructures.{ tagSimpleNumber }
+from "runtime/numbers" include Numbers
+use Numbers.{ isNumber, cmp as numberCompare }
 
-primitive (!): Bool -> Bool = "@not"
-primitive (||): (Bool, Bool) -> Bool = "@or"
-primitive (&&): (Bool, Bool) -> Bool = "@and"
+primitive (!) = "@not"
+primitive (||) = "@or"
+primitive (&&) = "@and"
 
 @unsafe
 let zero = WasmI32.fromGrain(0)
@@ -36,34 +41,28 @@ let rec heapCompareHelp = (heapTag, xptr, yptr) => {
       let xvariant = WasmI32.load(xptr, 12n)
       let yvariant = WasmI32.load(yptr, 12n)
       if (xvariant != yvariant) {
-        tagSimpleNumber(xvariant - yvariant)
-      } else {
-        let xarity = WasmI32.load(xptr, 16n)
-        let yarity = WasmI32.load(yptr, 16n)
-
-        let mut result = 0
+        return tagSimpleNumber(xvariant - yvariant)
+      }
+      let xarity = WasmI32.load(xptr, 16n)
+      let yarity = WasmI32.load(yptr, 16n)
 
-        let bytes = xarity * 4n
-        for (let mut i = 0n; i < bytes; i += 4n) {
-          let sub = compareHelp(
-            WasmI32.load(xptr + i, 20n),
-            WasmI32.load(yptr + i, 20n)
-          )
-          if (WasmI32.fromGrain(sub) != zero) {
-            result = sub
-            break
-          }
+      let bytes = xarity * 4n
+      for (let mut i = 0n; i < bytes; i += 4n) {
+        let sub = compareHelp(
+          WasmI32.load(xptr + i, 20n),
+          WasmI32.load(yptr + i, 20n)
+        )
+        if (WasmI32.fromGrain(sub) != zero) {
+          return sub
         }
-
-        result
       }
+
+      return 0
     },
     t when t == Tags._GRAIN_RECORD_HEAP_TAG => {
       let xlength = WasmI32.load(xptr, 12n)
       let ylength = WasmI32.load(yptr, 12n)
 
-      let mut result = 0
-
       let bytes = xlength * 4n
       for (let mut i = 0n; i < bytes; i += 4n) {
         let sub = compareHelp(
@@ -71,12 +70,11 @@ let rec heapCompareHelp = (heapTag, xptr, yptr) => {
           WasmI32.load(yptr + i, 16n)
         )
         if (WasmI32.fromGrain(sub) != zero) {
-          result = sub
-          break
+          return sub
         }
       }
 
-      result
+      return 0
     },
     t when t == Tags._GRAIN_ARRAY_HEAP_TAG => {
       let xlength = WasmI32.load(xptr, 4n)
@@ -84,49 +82,42 @@ let rec heapCompareHelp = (heapTag, xptr, yptr) => {
 
       // Check if the same length
       if (xlength != ylength) {
-        tagSimpleNumber(xlength - ylength)
-      } else {
-        let mut result = 0
-        let bytes = xlength * 4n
-        for (let mut i = 0n; i < bytes; i += 4n) {
-          let sub = compareHelp(
-            WasmI32.load(xptr + i, 8n),
-            WasmI32.load(yptr + i, 8n)
-          )
-          if (WasmI32.fromGrain(sub) != zero) {
-            result = sub
-            break
-          }
+        return tagSimpleNumber(xlength - ylength)
+      }
+      let bytes = xlength * 4n
+      for (let mut i = 0n; i < bytes; i += 4n) {
+        let sub = compareHelp(
+          WasmI32.load(xptr + i, 8n),
+          WasmI32.load(yptr + i, 8n)
+        )
+        if (WasmI32.fromGrain(sub) != zero) {
+          return sub
         }
-
-        result
       }
+
+      return 0
     },
-    t when (
-      t == Tags._GRAIN_STRING_HEAP_TAG || t == Tags._GRAIN_BYTES_HEAP_TAG
-    ) => {
+    t when t == Tags._GRAIN_STRING_HEAP_TAG || t == Tags._GRAIN_BYTES_HEAP_TAG => {
       let xlength = WasmI32.load(xptr, 4n)
       let ylength = WasmI32.load(yptr, 4n)
 
       if (xlength == ylength) {
-        tagSimpleNumber(Memory.compare(xptr + 8n, yptr + 8n, xlength))
+        return tagSimpleNumber(Memory.compare(xptr + 8n, yptr + 8n, xlength))
+      }
+      if (xlength < ylength) {
+        let sub = Memory.compare(xptr + 8n, yptr + 8n, xlength)
+        // The shorter one comes first
+        return if (sub == 0n) -1 else tagSimpleNumber(sub)
       } else {
-        if (xlength < ylength) {
-          let sub = Memory.compare(xptr + 8n, yptr + 8n, xlength)
-          // The shorter one comes first
-          if (sub == 0n) -1 else tagSimpleNumber(sub)
-        } else {
-          let sub = Memory.compare(xptr + 8n, yptr + 8n, ylength)
-          // The shorter one comes first
-          if (sub == 0n) 1 else tagSimpleNumber(sub)
-        }
+        let sub = Memory.compare(xptr + 8n, yptr + 8n, ylength)
+        // The shorter one comes first
+        return if (sub == 0n) 1 else tagSimpleNumber(sub)
       }
     },
     t when t == Tags._GRAIN_TUPLE_HEAP_TAG => {
       let xsize = WasmI32.load(xptr, 4n)
       let ysize = WasmI32.load(yptr, 4n)
 
-      let mut result = 0
       let bytes = xsize * 4n
       for (let mut i = 0n; i < bytes; i += 4n) {
         let sub = compareHelp(
@@ -134,34 +125,123 @@ let rec heapCompareHelp = (heapTag, xptr, yptr) => {
           WasmI32.load(yptr + i, 8n)
         )
         if (WasmI32.fromGrain(sub) != zero) {
-          result = sub
-          break
+          return sub
         }
       }
 
-      result
+      return 0
+    },
+    t when t == Tags._GRAIN_INT32_HEAP_TAG => {
+      let xval = WasmI32.load(xptr, 4n)
+      let yval = WasmI32.load(yptr, 4n)
+      return if (xval < yval) {
+        -1
+      } else if (xval > yval) {
+        1
+      } else {
+        0
+      }
+    },
+    // Float32 is handled by compareHelp directly
+    t when t == Tags._GRAIN_UINT32_HEAP_TAG => {
+      let xval = WasmI32.load(xptr, 4n)
+      let yval = WasmI32.load(yptr, 4n)
+      return if (WasmI32.ltU(xval, yval)) {
+        -1
+      } else if (WasmI32.gtU(xval, yval)) {
+        1
+      } else {
+        0
+      }
+    },
+    t when t == Tags._GRAIN_UINT64_HEAP_TAG => {
+      let xval = WasmI64.load(xptr, 8n)
+      let yval = WasmI64.load(yptr, 8n)
+      return if (WasmI64.ltU(xval, yval)) {
+        -1
+      } else if (WasmI64.gtU(xval, yval)) {
+        1
+      } else {
+        0
+      }
     },
     _ => {
       // No other implementation
-      tagSimpleNumber(xptr - yptr)
+      return tagSimpleNumber(xptr - yptr)
     },
   }
-},
-compareHelp = (x, y) => {
+}
+and compareHelp = (x, y) => {
   let xtag = x & Tags._GRAIN_GENERIC_TAG_MASK
   let ytag = y & Tags._GRAIN_GENERIC_TAG_MASK
   if ((xtag & ytag) != Tags._GRAIN_GENERIC_HEAP_TAG_TYPE) {
     // Short circuit for non-pointer values
     if ((xtag & Tags._GRAIN_NUMBER_TAG_MASK) == Tags._GRAIN_NUMBER_TAG_TYPE) {
       // Signed comparisons are necessary for numbers
-      if (x < y) -1 else if (x > y) 1 else 0
+      if (x < y) {
+        -1
+      } else if (x > y) {
+        1
+      } else {
+        0
+      }
+    } else if (xtag == Tags._GRAIN_SHORTVAL_TAG_TYPE) {
+      let shortValTag = x & Tags._GRAIN_GENERIC_SHORTVAL_TAG_MASK
+      if (
+        shortValTag == Tags._GRAIN_INT8_TAG_MASK ||
+        shortValTag == Tags._GRAIN_INT16_TAG_MASK
+      ) {
+        if (x < y) {
+          -1
+        } else if (x > y) {
+          1
+        } else {
+          0
+        }
+      } else {
+        if (WasmI32.ltU(x, y)) {
+          -1
+        } else if (WasmI32.gtU(x, y)) {
+          1
+        } else {
+          0
+        }
+      }
     } else {
       // Unsigned comparisons are necessary for other stack-allocated values
-      if (WasmI32.ltU(x, y)) -1 else if (WasmI32.gtU(x, y)) 1 else 0
+      if (WasmI32.ltU(x, y)) {
+        -1
+      } else if (WasmI32.gtU(x, y)) {
+        1
+      } else {
+        0
+      }
     }
   } else if (isNumber(x)) {
     // Numbers have special comparison rules, e.g. NaN == NaN
     tagSimpleNumber(numberCompare(x, y))
+  } else if (WasmI32.load(x, 0n) == Tags._GRAIN_FLOAT32_HEAP_TAG) {
+    // Short circuit for Float32 to correctly handle NaN comparisons
+    let xval = WasmF32.load(x, 4n)
+    let yval = WasmF32.load(y, 4n)
+    use WasmF32.{ (!=) }
+    let xIsNaN = xval != xval
+    let yIsNaN = yval != yval
+    if (xIsNaN) {
+      if (yIsNaN) 0 else -1
+    } else if (yIsNaN) {
+      // x is confirmed to be not NaN at this point
+      1
+    } else {
+      use WasmF32.{ (<), (>) }
+      if (xval < yval) {
+        -1
+      } else if (xval > yval) {
+        1
+      } else {
+        0
+      }
+    }
   } else {
     // Handle all other heap allocated things
     // Can short circuit if pointers are the same
@@ -173,7 +253,18 @@ compareHelp = (x, y) => {
   }
 }
 
+/**
+ * Compares the first argument to the second argument and produces an integer result.
+ * Provides a consistent ordering over all types and is suitable for sorting and other kinds of ordering.
+ * `compare` treats `NaN` differently than the other comparison operators in that it considers `NaN` equal to itself and smaller than any other number.
+ *
+ * @param num1: The first operand
+ * @param num2: The second operand
+ * @returns A negative integer if the first operand is less than the second operand, `0` if they are equal, or a positive integer otherwise
+ *
+ * @since v0.5.3
+ */
 @unsafe
-export let compare = (x: a, y: a) => {
-  compareHelp(WasmI32.fromGrain(x), WasmI32.fromGrain(y))
+provide let compare = (num1: a, num2: a) => {
+  compareHelp(WasmI32.fromGrain(num1), WasmI32.fromGrain(num2))
 }

package/runtime/compare.md

@@ -1,6 +1,36 @@
+---
+title: Compare
+---
+
+## Values
+
+Functions and constants included in the Compare module.
+
 ### Compare.**compare**
 
+<details disabled>
+<summary tabindex="-1">Added in <code>0.5.3</code></summary>
+No other changes yet.
+</details>
+
 ```grain
-compare : (a, a) -> Number
+compare : (num1: a, num2: a) => Number
 ```
 
+Compares the first argument to the second argument and produces an integer result.
+Provides a consistent ordering over all types and is suitable for sorting and other kinds of ordering.
+`compare` treats `NaN` differently than the other comparison operators in that it considers `NaN` equal to itself and smaller than any other number.
+
+Parameters:
+
+|param|type|description|
+|-----|----|-----------|
+|`num1`|`a`|The first operand|
+|`num2`|`a`|The second operand|
+
+Returns:
+
+|type|description|
+|----|-----------|
+|`Number`|A negative integer if the first operand is less than the second operand, `0` if they are equal, or a positive integer otherwise|
+

package/runtime/dataStructures.gr

@@ -1,22 +1,23 @@
-/* grainc-flags --no-pervasives */
+@noPervasives
+module DataStructures
 
 /**
  * Allocates a new Grain array.
  *
- * @param numElts: The number of elements to be contained in this array
+ * @param size: The number of elements to be contained in this array
  * @returns The pointer to the array
  */
 @unsafe
-export primitive allocateArray: WasmI32 -> WasmI32 = "@allocate.array"
+provide primitive allocateArray = "@allocate.array"
 
 /**
  * Allocates a new Grain tuple.
  *
- * @param numElts: The number of elements to be contained in this tuple
+ * @param size: The number of elements to be contained in this tuple
  * @returns The pointer to the tuple
  */
 @unsafe
-export primitive allocateTuple: WasmI32 -> WasmI32 = "@allocate.tuple"
+provide primitive allocateTuple = "@allocate.tuple"
 
 /**
  * Allocates a new Grain bytes.
@@ -25,7 +26,7 @@ export primitive allocateTuple: WasmI32 -> WasmI32 = "@allocate.tuple"
  * @returns The pointer to the bytes
  */
 @unsafe
-export primitive allocateBytes: WasmI32 -> WasmI32 = "@allocate.bytes"
+provide primitive allocateBytes = "@allocate.bytes"
 
 /**
  * Allocates a new Grain string.
@@ -34,7 +35,7 @@ export primitive allocateBytes: WasmI32 -> WasmI32 = "@allocate.bytes"
  * @returns The pointer to the string
  */
 @unsafe
-export primitive allocateString: WasmI32 -> WasmI32 = "@allocate.string"
+provide primitive allocateString = "@allocate.string"
 
 // INT32/INT64
 
@@ -44,15 +45,33 @@ export primitive allocateString: WasmI32 -> WasmI32 = "@allocate.string"
  * @returns The pointer to the empty Int32
  */
 @unsafe
-export primitive allocateInt32: () -> WasmI32 = "@allocate.int32"
+provide primitive allocateInt32 = "@allocate.int32"
 
 /**
  * Allocates a new Int32 with a prepopulated value
- * @param value: The value to store
+ *
+ * @param int: The value to store
  * @returns The pointer to the Int32
  */
 @unsafe
-export primitive newInt32: WasmI32 -> WasmI32 = "@new.int32"
+provide primitive newInt32 = "@new.int32"
+
+/**
+ * Allocates a new Uint32.
+ *
+ * @returns The pointer to the empty Uint32
+ */
+@unsafe
+provide primitive allocateUint32 = "@allocate.uint32"
+
+/**
+ * Allocates a new Uint32 with a prepopulated value
+ *
+ * @param int: The value to store
+ * @returns The pointer to the Uint32
+ */
+@unsafe
+provide primitive newUint32 = "@new.uint32"
 
 /**
  * Allocates a new Int64.
@@ -60,15 +79,33 @@ export primitive newInt32: WasmI32 -> WasmI32 = "@new.int32"
  * @returns The pointer to the empty Int64
  */
 @unsafe
-export primitive allocateInt64: () -> WasmI32 = "@allocate.int64"
+provide primitive allocateInt64 = "@allocate.int64"
 
 /**
  * Allocates a new Int64 with a prepopulated value
- * @param value: The value to store
+ *
+ * @param int: The value to store
  * @returns The pointer to the Int64
  */
 @unsafe
-export primitive newInt64: WasmI64 -> WasmI32 = "@new.int64"
+provide primitive newInt64 = "@new.int64"
+
+/**
+ * Allocates a new Uint64.
+ *
+ * @returns The pointer to the empty Uint64
+ */
+@unsafe
+provide primitive allocateUint64 = "@allocate.uint64"
+
+/**
+ * Allocates a new Uint64 with a prepopulated value
+ *
+ * @param int: The value to store
+ * @returns The pointer to the Uint64
+ */
+@unsafe
+provide primitive newUint64 = "@new.uint64"
 
 // FLOATS
 
@@ -78,15 +115,16 @@ export primitive newInt64: WasmI64 -> WasmI32 = "@new.int64"
  * @returns The pointer to the empty Float32
  */
 @unsafe
-export primitive allocateFloat32: () -> WasmI32 = "@allocate.float32"
+provide primitive allocateFloat32 = "@allocate.float32"
 
 /**
  * Allocates a new Float32 with a prepopulated value
- * @param value: The value to store
+ *
+ * @param float: The value to store
  * @returns the pointer to the Float32
  */
 @unsafe
-export primitive newFloat32: WasmF32 -> WasmI32 = "@new.float32"
+provide primitive newFloat32 = "@new.float32"
 
 /**
  * Allocates a new Float64.
@@ -94,15 +132,16 @@ export primitive newFloat32: WasmF32 -> WasmI32 = "@new.float32"
  * @returns The pointer to the empty Float64
  */
 @unsafe
-export primitive allocateFloat64: () -> WasmI32 = "@allocate.float64"
+provide primitive allocateFloat64 = "@allocate.float64"
 
 /**
  * Allocates a new Float64 with a prepopulated value
- * @param value: The value to store
+ *
+ * @param float: The value to store
  * @returns The pointer to the Float64
  */
 @unsafe
-export primitive newFloat64: WasmF64 -> WasmI32 = "@new.float64"
+provide primitive newFloat64 = "@new.float64"
 
 // RATIONALS
 
@@ -112,16 +151,17 @@ export primitive newFloat64: WasmF64 -> WasmI32 = "@new.float64"
  * @returns The pointer to the empty Rational
  */
 @unsafe
-export primitive allocateRational: () -> WasmI32 = "@allocate.rational"
+provide primitive allocateRational = "@allocate.rational"
 
 /**
  * Allocates a new Rational with a prepopulated value
- * @param value: The numerator value to store
- * @param value: The denominator value to store
+ *
+ * @param numerator: The numerator value to store
+ * @param denominator: The denominator value to store
  * @returns The pointer to the Rational
  */
 @unsafe
-export primitive newRational: (WasmI32, WasmI32) -> WasmI32 = "@new.rational"
+provide primitive newRational = "@new.rational"
 
 /**
  * Load the (tagged) variant of an ADT.
@@ -130,7 +170,7 @@ export primitive newRational: (WasmI32, WasmI32) -> WasmI32 = "@new.rational"
  * @returns The (tagged) ADT variant id
  */
 @unsafe
-export primitive loadAdtVariant: WasmI32 -> WasmI32 = "@adt.load_variant"
+provide primitive loadAdtVariant = "@adt.load_variant"
 
 /**
  * Load an untagged string's size.
@@ -139,7 +179,7 @@ export primitive loadAdtVariant: WasmI32 -> WasmI32 = "@adt.load_variant"
  * @returns The string size (in bytes)
  */
 @unsafe
-export primitive stringSize: WasmI32 -> WasmI32 = "@string.size"
+provide primitive stringSize = "@string.size"
 
 /**
  * Load an untagged Bytes' size.
@@ -148,7 +188,7 @@ export primitive stringSize: WasmI32 -> WasmI32 = "@string.size"
  * @returns The Bytes size (in bytes)
  */
 @unsafe
-export primitive bytesSize: WasmI32 -> WasmI32 = "@bytes.size"
+provide primitive bytesSize = "@bytes.size"
 
 /**
  * Tag a simple number.
@@ -157,7 +197,7 @@ export primitive bytesSize: WasmI32 -> WasmI32 = "@bytes.size"
  * @returns The tagged number
  */
 @unsafe
-export primitive tagSimpleNumber: WasmI32 -> Number = "@tag.simple_number"
+provide primitive tagSimpleNumber = "@tag.simple_number"
 
 /**
  * Untag a simple number.
@@ -166,22 +206,94 @@ export primitive tagSimpleNumber: WasmI32 -> Number = "@tag.simple_number"
  * @returns The untagged number
  */
 @unsafe
-export primitive untagSimpleNumber: Number -> WasmI32 = "@untag.simple_number"
+provide primitive untagSimpleNumber = "@untag.simple_number"
 
 /**
  * Tag a char.
  *
- * @param num: The usv to tag
+ * @param char: The usv to tag
  * @returns The tagged char
  */
 @unsafe
-export primitive tagChar: WasmI32 -> Char = "@tag.char"
+provide primitive tagChar = "@tag.char"
 
 /**
  * Untag a char.
  *
- * @param num: The char to untag
+ * @param char: The char to untag
  * @returns The untagged usv
  */
 @unsafe
-export primitive untagChar: Char -> WasmI32 = "@untag.char"
+provide primitive untagChar = "@untag.char"
+
+/**
+ * Tag an int8.
+ *
+ * @param int: The int8 to tag
+ * @returns The tagged int8
+ */
+@unsafe
+provide primitive tagInt8 = "@tag.int8"
+
+/**
+ * Untag an int8.
+ *
+ * @param int: The int8 to untag
+ * @returns The untagged int8
+ */
+@unsafe
+provide primitive untagInt8 = "@untag.int8"
+
+/**
+ * Tag an int16.
+ *
+ * @param int: The int16 to tag
+ * @returns The tagged int16
+ */
+@unsafe
+provide primitive tagInt16 = "@tag.int16"
+
+/**
+ * Untag an int16.
+ *
+ * @param int: The int16 to untag
+ * @returns The untagged int16
+ */
+@unsafe
+provide primitive untagInt16 = "@untag.int16"
+
+/**
+ * Tag a uint8.
+ *
+ * @param int: The uint8 to tag
+ * @returns The tagged uint8
+ */
+@unsafe
+provide primitive tagUint8 = "@tag.uint8"
+
+/**
+ * Untag a uint8.
+ *
+ * @param int: The uint8 to untag
+ * @returns The untagged uint8
+ */
+@unsafe
+provide primitive untagUint8 = "@untag.uint8"
+
+/**
+ * Tag a uint16.
+ *
+ * @param int: The uint16 to tag
+ * @returns The tagged uint16
+ */
+@unsafe
+provide primitive tagUint16 = "@tag.uint16"
+
+/**
+ * Untag a uint16.
+ *
+ * @param int: The uint16 to untag
+ * @returns The untagged uint16
+ */
+@unsafe
+provide primitive untagUint16 = "@untag.uint16"