forked from GitHub/haskell-wasm
fix reexports
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user