make digest and foundation backwards compatible with GHC < 9.10 (#5)

* make digest backwards compatible with GHC < 9.10 * make foundation compatible with GHC < 9.10
input-output-hk · Aug 5, 2024 · 16e49cd · 16e49cd
1 parent 6281362
commit 16e49cd
Show file tree

Hide file tree

Showing 2 changed files with 95 additions and 28 deletions.
diff --git a/patches/digest-0.0.1.2.patch b/patches/digest-0.0.1.2.patch
@@ -1,16 +1,19 @@
-diff --git b/Test.hs a/Test.hs
+diff --git a/Test.hs b/Test.hs
 new file mode 100644
-index 000000000..456818923
+index 0000000..d53608e
 --- /dev/null
-+++ a/Test.hs
++++ b/Test.hs
 @@ -0,0 +1,5 @@
 +import Data.Digest.CRC32
 +
 +main :: IO ()
 +main = do
 +    print $ crc32 [1,2,3,4,5]
 \ No newline at end of file
-diff --git b/digest.cabal a/digest.cabal
+diff --git a/digest.cabal b/digest.cabal
+index eaea373..223bf21 100644
+--- a/digest.cabal
++++ b/digest.cabal
 @@ -45,3 +45,20 @@ library
      extra-libraries: z
    else
@@ -32,22 +35,47 @@ diff --git b/digest.cabal a/digest.cabal
 +  main-is:       Test.hs
 +  build-depends: digest -any
 +               , base
-diff --git b/jsbits/bindings.js a/jsbits/bindings.js
+diff --git a/jsbits/bindings.js b/jsbits/bindings.js
 new file mode 100644
-index 000000000..783592c90
+index 0000000..35ea231
 --- /dev/null
-+++ a/jsbits/bindings.js
-@@ -0,0 +1,13 @@
++++ b/jsbits/bindings.js
+@@ -0,0 +1,38 @@
++// **** Start backwards compatibility ****
++
++// These functions have been copied here from rts/js/mem.js (GHC 9.10+)
++// to provide compatibility with earlier versions of GHC. They should
++// be removed here when support for GHC earlier than 9.10 is dropped.
++
++function h$digest$compat$withCBufferOnHeap(str_d, str_o, len, cont) {
++    var str = _malloc(len);
++    if(str_d !== null) h$digest$compat$copyToHeap(str_d, str_o, str, len);
++    var ret = cont(str);
++    _free(str);
++    return ret;
++}
++
++function h$digest$compat$copyToHeap(buf_d, buf_o, tgt, len) {
++    if(len === 0) return;
++    var u8 = buf_d.u8;
++    for(var i=0;i<len;i++) {
++        Module.HEAPU8[tgt+i] = u8[buf_o+i];
++    }
++}
++
++// **** End backwards compatibility ****
++
++
 +// EMCC:EXPORTED_FUNCTIONS _malloc _free
 +// EMCC:EXPORTED_FUNCTIONS _adler32 _crc32
 +function h$adler32(adler, buf_d, buf_o, buf_len) {
-+    return h$withCBufferOhHeap(buf_d, buf_o, buf_len, function(buf) {
++    return h$digest$compat$withCBufferOnHeap(buf_d, buf_o, buf_len, function(buf) {
 +        return _adler32(adler, buf, buf_len);
 +    });
 +}
 +
 +function h$crc32(crc, buf_d, buf_o, buf_len) {
-+    return h$withCBufferOnHeap(buf_d, buf_o, buf_len, function(buf) {
++    return h$digest$compat$withCBufferOnHeap(buf_d, buf_o, buf_len, function(buf) {
 +        return _crc32(crc, buf, buf_len);
 +    });
 +}

diff --git a/patches/foundation-0.0.30.patch b/patches/foundation-0.0.30.patch
@@ -1,3 +1,19 @@
+diff --git a/cbits/foundation_prim.h b/cbits/foundation_prim.h
+index 81eb475..6ac0241 100644
+--- a/cbits/foundation_prim.h
++++ b/cbits/foundation_prim.h
+@@ -1,6 +1,11 @@
+ #ifndef FOUNDATION_PRIM_H
+ #define FOUNDATION_PRIM_H
++
++#ifdef EMSCRIPTEN
++typedef int StgInt;
++#else
+ #include "Rts.h"
++#endif
+
+ typedef StgInt FsOffset;
+ typedef StgInt FsCountOf;
 diff --git a/foundation.cabal b/foundation.cabal
 index d33d874..fca3fc9 100644
 --- a/foundation.cabal
@@ -35,10 +51,49 @@ index d33d874..fca3fc9 100644
      build-depends:   base
 diff --git a/jsbits/bindings.js b/jsbits/bindings.js
 new file mode 100644
-index 0000000..fc51a85
+index 0000000..f9874b3
 --- /dev/null
 +++ b/jsbits/bindings.js
-@@ -0,0 +1,28 @@
+@@ -0,0 +1,67 @@
++
++
++// These functions have been copied here from rts/js/mem.js (GHC 9.10+)
++// to provide compatibility with earlier versions of GHC. They should
++// be removed here when support for GHC earlier than 9.10 is dropped.
++
++function h$foundation$compat$withCBufferOnHeap(str_d, str_o, len, cont) {
++    var str = _malloc(len);
++    if(str_d !== null) h$foundation$compat$copyToHeap(str_d, str_o, str, len);
++    var ret = cont(str);
++    _free(str);
++    return ret;
++}
++
++function h$foundation$compat$withOutBufferOnHeap(ptr_d, ptr_o, len, cont) {
++    var ptr = _malloc(len);
++    h$foundation$compat$copyToHeap(ptr_d, ptr_o, ptr, len);
++    var ret = cont(ptr);
++    h$foundation$compat$copyFromHeap(ptr, ptr_d, ptr_o, len);
++    _free(ptr);
++    return ret;
++  }
++
++function h$foundation$compat$copyToHeap(buf_d, buf_o, tgt, len) {
++    if(len === 0) return;
++    var u8 = buf_d.u8;
++    for(var i=0;i<len;i++) {
++        Module.HEAPU8[tgt+i] = u8[buf_o+i];
++    }
++}
++
++function h$foundation$compat$copyFromHeap(src, buf_d, buf_o, len) {
++    var u8 = buf_d.u8;
++    for(var i=0;i<len;i++) {
++        u8[buf_o+i] = Module.HEAPU8[src+i];
++    }
++}
++
++// **** End backwards compatibility ****
 +
 +// EMCC:EXPORTED_FUNCTIONS _malloc _free
 +// EMCC:EXPORTED_FUNCTIONS _foundation_rngV1_generate
@@ -68,19 +123,3 @@ index 0000000..fc51a85
 +    });
 +}
 \ No newline at end of file
-diff --git a/cbits/foundation_prim.h b/cbits/foundation_prim.h
-index 81eb475..6ac0241 100644
---- a/cbits/foundation_prim.h
-+++ b/cbits/foundation_prim.h
-@@ -1,6 +1,11 @@
- #ifndef FOUNDATION_PRIM_H
- #define FOUNDATION_PRIM_H
-+
-+#ifdef EMSCRIPTEN
-+typedef int StgInt;
-+#else
- #include "Rts.h"
-+#endif
-
- typedef StgInt FsOffset;
- typedef StgInt FsCountOf;