From bb2a6cea7f5a32458c53eb5a3380cddc14999512 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 21 Aug 2023 08:23:58 -0600
Subject: [PATCH] fix reexports

---
 src/Language/Wasm/Interpreter.hs |  5 +++--
 src/Language/Wasm/Parser.y       | 20 ++++++++++++++------
 src/Language/Wasm/Validate.hs    |  2 +-
 tests/Test.hs                    |  2 +-
 4 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 0e5c8b3..92c901b 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -423,8 +423,9 @@ calcInstance (Store fs ts ms gs es ds) imps mod = do
             memAddr <- case idx of
                 ExternMemory memAddr -> return memAddr
                 _ -> throwError "incompatible import type"
-            let MemoryInstance { lim } = ms ! memAddr
-            if limitMatch lim limit
+            let MemoryInstance { lim = Limit _ limMax, memory = mem } = ms ! memAddr
+            size <- liftIO $ (`quot` pageSize) <$> (readIORef mem >>= ByteArray.getSizeofMutableByteArray)
+            if limitMatch (Limit (fromIntegral size) limMax) limit
             then return idx
             else throwError "incompatible import type"
         checkImportType imp@(Import _ _ (ImportTable (TableType limit et))) = do
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 79a00ab..e49dda1 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -2167,14 +2167,22 @@ desugarize fields = do
         -- exports
         extractExports :: Module -> [ModuleField] -> [ModuleField]
         extractExports mod mf =
-            let initial = (funcImportLength, globImportLength, memImportLength, tableImportLength, []) in
-            let (_, _, _, _, result) = foldl' extractExport initial mf in
+            let fromImports = foldl' reexport (0, 0, 0, 0, []) $ imports mod in
+            let (_, _, _, _, result) = foldl' extractExport fromImports mf in
             reverse result
             where
-                funcImportLength = fromIntegral $ length $ filter isFuncImport $ imports mod
-                globImportLength = fromIntegral $ length $ filter isGlobalImport $ imports mod
-                memImportLength = fromIntegral $ length $ filter isMemImport $ imports mod
-                tableImportLength = fromIntegral $ length $ filter isTableImport $ imports mod
+                reexport (fidx, gidx, midx, tidx, mf) (Import {reExportAs, desc = ImportFunc _ _}) =
+                    let exports = map (\name -> MFExport $ Export name $ ExportFunc $ Index fidx) reExportAs in
+                    (fidx + 1, gidx, midx, tidx, exports ++ mf)
+                reexport (fidx, gidx, midx, tidx, mf) (Import {reExportAs, desc = ImportGlobal _ _}) =
+                    let exports = map (\name -> MFExport $ Export name $ ExportGlobal $ Index gidx) reExportAs in
+                    (fidx, gidx + 1, midx, tidx, exports ++ mf)
+                reexport (fidx, gidx, midx, tidx, mf) (Import {reExportAs, desc = ImportMemory _ _}) =
+                    let exports = map (\name -> MFExport $ Export name $ ExportMemory $ Index midx) reExportAs in
+                    (fidx, gidx, midx + 1, tidx, exports ++ mf)
+                reexport (fidx, gidx, midx, tidx, mf) (Import {reExportAs, desc = ImportTable _ _}) =
+                    let exports = map (\name -> MFExport $ Export name $ ExportTable $ Index tidx) reExportAs in
+                    (fidx, gidx, midx, tidx + 1, exports ++ mf)
 
                 extractExport (fidx, gidx, midx, tidx, mf) (MFFunc fun@Function{ exportFuncAs }) =
                     let exports = map (\name -> MFExport $ Export name $ ExportFunc $ Index fidx) exportFuncAs in
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index dbd34f4..f871b5f 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -65,7 +65,7 @@ instance Monoid ValidationResult where
 
 isValid :: ValidationResult -> Bool
 isValid (Right ()) = True
-isValid (Left reason) = Debug.trace ("Module mismatched with reason " ++ show reason) $ False
+isValid (Left reason) = False
 
 type Validator = Module -> ValidationResult
 
diff --git a/tests/Test.hs b/tests/Test.hs
index e9b9a7b..a074f67 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["linking.wast"]
+  -- let files = ["imports.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do