@grain/stdlib 0.6.6 → 0.7.1

package/runtime/gc.gr

@@ -21,21 +21,20 @@ module GC
 
 from "runtime/malloc" include Malloc
 from "runtime/unsafe/tags" include Tags
+from "runtime/unsafe/panic" include Panic
 from "runtime/unsafe/wasmi32" include WasmI32
 use WasmI32.{ (+), (-), (*), (&), (==), (!=) }
 
-// Using foreigns directly here to avoid cyclic dependency
-foreign wasm fd_write:
-  (WasmI32, WasmI32, WasmI32, WasmI32) => WasmI32 from "wasi_snapshot_preview1"
-
+primitive (!) = "@not"
 primitive (&&) = "@and"
 primitive (||) = "@or"
-primitive throw = "@throw"
 primitive ignore = "@ignore"
 primitive box = "@box"
 primitive unbox = "@unbox"
 
-exception DecRefError
+let throwDecRefError = () => {
+  Panic.panic("DecRefError: Reference count of zero")
+}
 
 let mut _DEBUG = false
 
@@ -86,24 +85,37 @@ let rec decRef = (userPtr: WasmI32, ignoreZeros: Bool) => {
     // }
 
     if (WasmI32.eqz(refCount)) {
-      if (ignoreZeros) {
-        userPtr
-      } else {
-        throw DecRefError
+      if (!ignoreZeros) {
+        throwDecRefError()
       }
     } else {
       let refCount = refCount - 1n
       setRefCount(userPtr, refCount)
 
       if (WasmI32.eqz(refCount)) {
-        decRefChildren(userPtr)
+        /*
+         * Note: We call free before decRefChildren to allow for a tail call.
+         * This is okay because no allocations occur while we traverse the
+         * structure and free does not mangle the data.
+         */
         free(userPtr)
+        decRefChildren(userPtr)
       }
-
-      userPtr
     }
-  } else {
-    userPtr
+  }
+}
+and decRefChildrenHelp = (
+  userPtr: WasmI32,
+  arityOffset: WasmI32,
+  offset: WasmI32,
+) => {
+  let arity = WasmI32.load(userPtr, arityOffset)
+  if (arity != 0n) {
+    let maxOffset = (arity - 1n) * 4n
+    for (let mut i = 0n; WasmI32.ltU(i, maxOffset); i += 4n) {
+      decRef(WasmI32.load(userPtr + i, offset), false)
+    }
+    decRef(WasmI32.load(userPtr + maxOffset, offset), false)
   }
 }
 and decRefChildren = (userPtr: WasmI32) => {
@@ -112,43 +124,25 @@ and decRefChildren = (userPtr: WasmI32) => {
       let tag = WasmI32.load(userPtr, 4n)
       if (userPtr == Tags._GRAIN_RATIONAL_BOXED_NUM_TAG) {
         // decRef underlying BigInts
-        ignore(decRef(WasmI32.load(userPtr, 8n), false))
-        ignore(decRef(WasmI32.load(userPtr, 12n), false))
+        decRef(WasmI32.load(userPtr, 8n), false)
+        decRef(WasmI32.load(userPtr, 12n), false)
       }
     },
     t when t == Tags._GRAIN_ADT_HEAP_TAG => {
-      let arity = WasmI32.load(userPtr, 16n)
-      let maxOffset = arity * 4n
-      for (let mut i = 0n; WasmI32.ltU(i, maxOffset); i += 4n) {
-        ignore(decRef(WasmI32.load(userPtr + i, 20n), false))
-      }
+      decRefChildrenHelp(userPtr, 16n, 20n)
     },
-    t when t == Tags._GRAIN_RECORD_HEAP_TAG => {
-      let arity = WasmI32.load(userPtr, 12n)
-      let maxOffset = arity * 4n
-      for (let mut i = 0n; WasmI32.ltU(i, maxOffset); i += 4n) {
-        ignore(decRef(WasmI32.load(userPtr + i, 16n), false))
-      }
+    t when t == Tags._GRAIN_RECORD_HEAP_TAG || t == Tags._GRAIN_LAMBDA_HEAP_TAG => {
+      decRefChildrenHelp(userPtr, 12n, 16n)
     },
     t when t == Tags._GRAIN_ARRAY_HEAP_TAG || t == Tags._GRAIN_TUPLE_HEAP_TAG => {
-      let arity = WasmI32.load(userPtr, 4n)
-      let maxOffset = arity * 4n
-      for (let mut i = 0n; WasmI32.ltU(i, maxOffset); i += 4n) {
-        ignore(decRef(WasmI32.load(userPtr + i, 8n), false))
-      }
-    },
-    t when t == Tags._GRAIN_LAMBDA_HEAP_TAG => {
-      let arity = WasmI32.load(userPtr, 12n)
-      let maxOffset = arity * 4n
-      for (let mut i = 0n; WasmI32.ltU(i, maxOffset); i += 4n) {
-        ignore(decRef(WasmI32.load(userPtr + i, 16n), false))
-      }
-    },
-    _ => {
-      // No travelsal necessary for other tags
-      void
+      decRefChildrenHelp(userPtr, 4n, 8n)
     },
+    // No traversal necessary for other tags
+    _ => void,
   }
 }
 
-provide let decRef = userPtr => decRef(userPtr, false)
+provide let decRef = userPtr => {
+  decRef(userPtr, false)
+  userPtr
+}

package/runtime/gc.md

@@ -9,24 +9,24 @@ Functions and constants included in the GC module.
 ### GC.**malloc**
 
 ```grain
-malloc : (size: WasmI32) => WasmI32
+malloc: (size: WasmI32) => WasmI32
 ```
 
 ### GC.**free**
 
 ```grain
-free : (userPtr: WasmI32) => Void
+free: (userPtr: WasmI32) => Void
 ```
 
 ### GC.**incRef**
 
 ```grain
-incRef : (userPtr: WasmI32) => WasmI32
+incRef: (userPtr: WasmI32) => WasmI32
 ```
 
 ### GC.**decRef**
 
 ```grain
-decRef : (userPtr: WasmI32) => WasmI32
+decRef: (userPtr: WasmI32) => WasmI32
 ```
 

package/runtime/malloc.gr

@@ -21,7 +21,7 @@ use WasmI32.{
   (&),
   (^),
 }
-from "runtime/exception" include Exception
+from "runtime/unsafe/panic" include Panic
 
 primitive memorySize = "@wasm.memory_size"
 primitive memoryGrow = "@wasm.memory_grow"
@@ -38,12 +38,12 @@ primitive heapStart = "@heap.start"
  * lists are maintained, one for small blocks of 64 bytes, and one for larger
  * blocks of multiples of 64 bytes. Each block has an 8-byte header and 8-byte
  * footer to keep track of block sizes and maintain the free list.
- * 
+ *
  * Most allocations in programs are small, so the separate free lists allow us
  * to implement `malloc` and `free` in O(1) for small allocations and O(n)
  * `malloc` and O(1) `free` for large allocations, where `n` is the size of the
  * free list for large blocks.
- * 
+ *
  * The small blocks are able to service:
  *  - Numbers (with the exception of large BigInts/Rationals)
  *  - Tuples/Arrays up to 8 elements
@@ -51,7 +51,7 @@ primitive heapStart = "@heap.start"
  *  - Variants up to 5 elements
  *  - Closures up to 6 elements
  *  - Bytes/Strings up to length 32
- * 
+ *
  * Blocks in memory look like this:
  *
  *       8 bytes              8 bytes       64n - 16 bytes       8 bytes            8 bytes
@@ -71,11 +71,11 @@ primitive heapStart = "@heap.start"
  *
  * The size is kept in the header and footer to allow us to quickly combine
  * free blocks when blocks are freed.
- * 
+ *
  * Pointers to the previous/next free blocks give us doubly-linked free lists,
  * which makes it possible to remove blocks from the free list in constant
  * time.
- * 
+ *
  * A block is considered in use when the previous/next pointers are both zero.
  */
 
@@ -329,7 +329,7 @@ let morecore = (nunits: WasmI32) => {
 
   // If there was an error, fail
   if (cp == -1n) {
-    Exception.panic("OutOfMemory: Maximum memory size exceeded")
+    Panic.panic("OutOfMemory: Maximum memory size exceeded")
   } else {
     // Set up the block. We'll add dummy headers/footers before and after the
     // block to avoid unnecessary bounds checks elsewhere in the code.

package/runtime/malloc.md

@@ -9,47 +9,47 @@ Functions and constants included in the Malloc module.
 ### Malloc.**_RESERVED_RUNTIME_SPACE**
 
 ```grain
-_RESERVED_RUNTIME_SPACE : WasmI32
+_RESERVED_RUNTIME_SPACE: WasmI32
 ```
 
 ### Malloc.**free**
 
 ```grain
-free : (ap: WasmI32) => Void
+free: (ap: WasmI32) => Void
 ```
 
 Frees the given allocated pointer.
 
 Parameters:
 
-|param|type|description|
-|-----|----|-----------|
-|`ap`|`WasmI32`|The pointer to free|
+| param | type      | description         |
+| ----- | --------- | ------------------- |
+| `ap`  | `WasmI32` | The pointer to free |
 
 ### Malloc.**malloc**
 
 ```grain
-malloc : (nbytes: WasmI32) => WasmI32
+malloc: (nbytes: WasmI32) => WasmI32
 ```
 
 Allocates the requested number of bytes, returning a pointer.
 
 Parameters:
 
-|param|type|description|
-|-----|----|-----------|
-|`nbytes`|`WasmI32`|The number of bytes to allocate|
+| param    | type      | description                     |
+| -------- | --------- | ------------------------------- |
+| `nbytes` | `WasmI32` | The number of bytes to allocate |
 
 Returns:
 
-|type|description|
-|----|-----------|
-|`WasmI32`|The pointer to the allocated region (8-byte aligned) or -1 if the allocation failed|
+| type      | description                                                                         |
+| --------- | ----------------------------------------------------------------------------------- |
+| `WasmI32` | The pointer to the allocated region (8-byte aligned) or -1 if the allocation failed |
 
 ### Malloc.**leakAll**
 
 ```grain
-leakAll : () => Void
+leakAll: () => Void
 ```
 
 Leaks all memory in all free lists; used for testing.

package/runtime/math/kernel/cos.gr

@@ -0,0 +1,70 @@
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+module Cosine
+
+from "runtime/unsafe/wasmf64" include WasmF64
+
+/*
+ * Source: https://git.musl-libc.org/cgit/musl/tree/src/math/__cos.c
+ *
+ * kernel cos function on [-pi/4, pi/4], pi/4 ~ 0.785398164
+ * Input x is assumed to be bounded by ~pi/4 in magnitude.
+ * Input y is the tail of x.
+ *
+ * Algorithm
+ *      1. Since cos(-x) = cos(x), we need only to consider positive x.
+ *      2. if x < 2^-27 (hx<0x3e400000 0), return 1 with inexact if x!=0.
+ *      3. cos(x) is approximated by a polynomial of degree 14 on
+ *         [0,pi/4]
+ *                                       4            14
+ *              cos(x) ~ 1 - x*x/2 + C1*x + ... + C6*x
+ *         where the remez error is
+ *
+ *      |              2     4     6     8     10    12     14 |     -58
+ *      |cos(x)-(1-.5*x +C1*x +C2*x +C3*x +C4*x +C5*x  +C6*x  )| <= 2
+ *      |                                                      |
+ *
+ *                     4     6     8     10    12     14
+ *      4. let r = C1*x +C2*x +C3*x +C4*x +C5*x  +C6*x  , then
+ *             cos(x) ~ 1 - x*x/2 + r
+ *         since cos(x+y) ~ cos(x) - sin(x)*y
+ *                        ~ cos(x) - x*y,
+ *         a correction term is necessary in cos(x) and hence
+ *              cos(x+y) = 1 - (x*x/2 - (r - x*y))
+ *         For better accuracy, rearrange to
+ *              cos(x+y) ~ w + (tmp + (r-x*y))
+ *         where w = 1 - x*x/2 and tmp is a tiny correction term
+ *         (1 - x*x/2 == w + tmp exactly in infinite precision).
+ *         The exactness of w + tmp in infinite precision depends on w
+ *         and tmp having the same precision as x.  If they have extra
+ *         precision due to compiler bugs, then the extra precision is
+ *         only good provided it is retained in all terms of the final
+ *         expression for cos().  Retention happens in all cases tested
+ *         under FreeBSD, so don't pessimize things by forcibly clipping
+ *         any extra precision in w.
+ */
+@unsafe
+provide let cos = (x: WasmF64, y: WasmF64) => {
+  use WasmF64.{ (+), (-), (*) }
+  let c1 = 4.16666666666666019037e-02W /* 0x3FA55555, 0x5555554C */
+  let c2 = -1.38888888888741095749e-03W /* 0xBF56C16C, 0x16C15177 */
+  let c3 = 2.48015872894767294178e-05W /* 0x3EFA01A0, 0x19CB1590 */
+  let c4 = -2.75573143513906633035e-07W /* 0xBE927E4F, 0x809C52AD */
+  let c5 = 2.08757232129817482790e-09W /* 0x3E21EE9E, 0xBDB4B1C4 */
+  let c6 = -1.13596475577881948265e-11W /* 0xBDA8FAE9, 0xBE8838D4 */
+
+  let z = x * x
+  let w = z * z
+  let r = z * (c1 + z * (c2 + z * c3)) + w * w * (c4 + z * (c5 + z * c6))
+  let hz = 0.5W * z
+  let w = 1.0W - hz
+  w + (1.0W - w - hz + (z * r - x * y))
+}

package/runtime/math/kernel/cos.md

@@ -0,0 +1,14 @@
+---
+title: Cosine
+---
+
+## Values
+
+Functions and constants included in the Cosine module.
+
+### Cosine.**cos**
+
+```grain
+cos: (x: WasmF64, y: WasmF64) => WasmF64
+```
+

package/runtime/math/kernel/sin.gr

@@ -0,0 +1,65 @@
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+module Sine
+
+from "runtime/unsafe/wasmf64" include WasmF64
+
+/*
+ * Source: https://git.musl-libc.org/cgit/musl/tree/src/math/__sin.c
+ *
+ * kernel sin function on ~[-pi/4, pi/4] (except on -0), pi/4 ~ 0.7854
+ * Input x is assumed to be bounded by ~pi/4 in magnitude.
+ * Input y is the tail of x.
+ * Input iy indicates whether y is 0. (if iy=0, y assume to be 0).
+ *
+ * Algorithm
+ *      1. Since sin(-x) = -sin(x), we need only to consider positive x.
+ *      2. Callers must return sin(-0) = -0 without calling here since our
+ *         odd polynomial is not evaluated in a way that preserves -0.
+ *         Callers may do the optimization sin(x) ~ x for tiny x.
+ *      3. sin(x) is approximated by a polynomial of degree 13 on
+ *         [0,pi/4]
+ *                               3            13
+ *              sin(x) ~ x + S1*x + ... + S6*x
+ *         where
+ *
+ *      |sin(x)         2     4     6     8     10     12  |     -58
+ *      |----- - (1+S1*x +S2*x +S3*x +S4*x +S5*x  +S6*x   )| <= 2
+ *      |  x                                               |
+ *
+ *      4. sin(x+y) = sin(x) + sin'(x')*y
+ *                  ~ sin(x) + (1-x*x/2)*y
+ *         For better accuracy, let
+ *                   3      2      2      2      2
+ *              r = x *(S2+x *(S3+x *(S4+x *(S5+x *S6))))
+ *         then                   3    2
+ *              sin(x) = x + (S1*x + (x *(r-y/2)+y))
+ */
+@unsafe
+provide let sin = (x: WasmF64, y: WasmF64, iy: Bool) => { // see: musl/tree/src/math/__sin.c
+  use WasmF64.{ (+), (-), (*) }
+  let s1 = -1.66666666666666324348e-01W /* 0xBFC55555, 0x55555549 */
+  let s2 = 8.33333333332248946124e-03W /* 0x3F811111, 0x1110F8A6 */
+  let s3 = -1.98412698298579493134e-04W /* 0xBF2A01A0, 0x19C161D5 */
+  let s4 = 2.75573137070700676789e-06W /* 0x3EC71DE3, 0x57B1FE7D */
+  let s5 = -2.50507602534068634195e-08W /* 0xBE5AE5E6, 0x8A2B9CEB */
+  let s6 = 1.58969099521155010221e-10W /* 0x3DE5D93A, 0x5ACFD57C */
+
+  let z = x * x
+  let w = z * z
+  let r = s2 + z * (s3 + z * s4) + z * w * (s5 + z * s6)
+  let v = z * x
+  if (!iy) {
+    x + v * (s1 + z * r)
+  } else {
+    x - (z * (0.5W * y - v * r) - y - v * s1)
+  }
+}

package/runtime/math/kernel/sin.md

@@ -0,0 +1,14 @@
+---
+title: Sine
+---
+
+## Values
+
+Functions and constants included in the Sine module.
+
+### Sine.**sin**
+
+```grain
+sin: (x: WasmF64, y: WasmF64, iy: Bool) => WasmF64
+```
+

package/runtime/math/kernel/tan.gr

@@ -0,0 +1,136 @@
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+module Tangent
+
+from "runtime/unsafe/wasmi32" include WasmI32
+from "runtime/unsafe/wasmi64" include WasmI64
+from "runtime/unsafe/wasmf64" include WasmF64
+
+/*
+ * Source: lib/msun/src/k_tan.c
+ *
+ * kernel tan function on ~[-pi/4, pi/4] (except on -0), pi/4 ~ 0.7854
+ * Input x is assumed to be bounded by ~pi/4 in magnitude.
+ * Input y is the tail of x.
+ * Input k indicates whether tan (if k = 1) or -1/tan (if k = -1) is returned.
+ *
+ * Algorithm
+ *	1. Since tan(-x) = -tan(x), we need only to consider positive x.
+ *	2. Callers must return tan(-0) = -0 without calling here since our
+ *	   odd polynomial is not evaluated in a way that preserves -0.
+ *	   Callers may do the optimization tan(x) ~ x for tiny x.
+ *	3. tan(x) is approximated by a odd polynomial of degree 27 on
+ *	   [0,0.67434]
+ *		  	         3             27
+ *	   	tan(x) ~ x + T1*x + ... + T13*x
+ *	   where
+ *
+ * 	        |tan(x)         2     4            26   |     -59.2
+ * 	        |----- - (1+T1*x +T2*x +.... +T13*x    )| <= 2
+ * 	        |  x 					|
+ *
+ *	   Note: tan(x+y) = tan(x) + tan'(x)*y
+ *		          ~ tan(x) + (1+x*x)*y
+ *	   Therefore, for better accuracy in computing tan(x+y), let
+ *		     3      2      2       2       2
+ *		r = x *(T2+x *(T3+x *(...+x *(T12+x *T13))))
+ *	   then
+ *		 		    3    2
+ *		tan(x+y) = x + (T1*x + (x *(r+y)+y))
+ *
+ *      4. For x in [0.67434,pi/4],  let y = pi/4 - x, then
+ *		tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y))
+ *		       = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y)))
+ */
+@unsafe
+provide let tan = (x: WasmF64, y: WasmF64, iy: Bool) => {
+  use WasmI32.{ (&), (>>), (<), (>=) }
+  use WasmI64.{ (>>>) }
+  use WasmF64.{ (-), (+), (*), (/) }
+  let t0 = 3.33333333333334091986e-01W /* 3FD55555, 55555563 */
+  let t1 = 1.33333333333201242699e-01W /* 3FC11111, 1110FE7A */
+  let t2 = 5.39682539762260521377e-02W /* 3FABA1BA, 1BB341FE */
+  let t3 = 2.18694882948595424599e-02W /* 3F9664F4, 8406D637 */
+  let t4 = 8.86323982359930005737e-03W /* 3F8226E3, E96E8493 */
+  let t5 = 3.59207910759131235356e-03W /* 3F6D6D22, C9560328 */
+  let t6 = 1.45620945432529025516e-03W /* 3F57DBC8, FEE08315 */
+  let t7 = 5.88041240820264096874e-04W /* 3F4344D8, F2F26501 */
+  let t8 = 2.46463134818469906812e-04W /* 3F3026F7, 1A8D1068 */
+  let t9 = 7.81794442939557092300e-05W /* 3F147E88, A03792A6 */
+  let t10 = 7.14072491382608190305e-05W /* 3F12B80F, 32F0A7E9 */
+  let t11 = -1.85586374855275456654e-05W /* BEF375CB, DB605373 */
+  let t12 = 2.59073051863633712884e-05W /* 3EFB2A70, 74BF7AD4 */
+  let pio4 = 7.85398163397448278999e-01W /* 3FE921FB, 54442D18 */
+  let pio4lo = 3.06161699786838301793e-17W /* 3C81A626, 33145C07 */
+
+  let mut x = x
+  let mut y = y
+  let mut z = 0.0W
+  let mut r = 0.0W
+  let mut w = 0.0W
+
+  let h = WasmI64.reinterpretF64(x)
+  let hx = WasmI32.wrapI64(h >>> 32N) // High word of {x}
+  let ix = hx & 0x7FFFFFFFn // High word of |x|
+
+  let isBig = ix >= 0x3FE59428n
+  if (isBig) { /* |x| >= 0.6744 */
+    if (hx < 0n) {
+      x *= -1.0W
+      y *= -1.0W
+    }
+    z = pio4 - x
+    w = pio4lo - y
+    x = z + w
+    y = 0.0W
+  }
+  z = x * x
+  w = z * z
+
+  /*
+	 * Break x^5*(T[1]+x^2*T[2]+...) into
+	 * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) +
+	 * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12]))
+	 */
+  r = t1 + w * (t3 + w * (t5 + w * (t7 + w * (t9 + w * t11))))
+  let v = z * (t2 + w * (t4 + w * (t6 + w * (t8 + w * (t10 + w * t12)))))
+  let s = z * x
+  r = y + z * (s * (r + v) + y)
+  r += t0 * s
+  w = x + r
+  if (isBig) {
+    let v = if (iy) 1.0W else 0.0W
+    return 1.0W
+      - WasmF64.convertI32S(hx >> 30n & 2n)
+        * (v - 2.0W * (x - (w * w / (w + v) - r)))
+  }
+  if (iy) return w
+  /*
+   * if allow error up to 2 ulp, simply return
+   * -1.0 / (x+r) here
+   */
+  // compute -1.0 / (x+r) accurately
+  use WasmI64.{ (&) }
+  // Set low bits
+  let z = w
+  let z = WasmF64.reinterpretI64(
+    WasmI64.reinterpretF64(z) & 0xFFFFFFFF00000000N
+  )
+  let v = r - (z - x) // z + v = r + x
+  let a = -1.0W / w
+  let t = a
+  // Set low bits
+  let t = WasmF64.reinterpretI64(
+    WasmI64.reinterpretF64(t) & 0xFFFFFFFF00000000N
+  )
+  let s = 1.0W + t * z
+  return t + a * (s + t * v)
+}

package/runtime/math/kernel/tan.md

@@ -0,0 +1,14 @@
+---
+title: Tangent
+---
+
+## Values
+
+Functions and constants included in the Tangent module.
+
+### Tangent.**tan**
+
+```grain
+tan: (x: WasmF64, y: WasmF64, iy: Bool) => WasmF64
+```
+