fix build and tests for ghc >8.6
This commit is contained in:
+8
-1
@@ -1,3 +1,10 @@
|
|||||||
.stack-work
|
.stack-work
|
||||||
tests/runnable/*
|
tests/runnable/*
|
||||||
dist/
|
dist/
|
||||||
|
.DS_Store
|
||||||
|
build/
|
||||||
|
cabal-config-flags
|
||||||
|
dist-newstyle/
|
||||||
|
doc/
|
||||||
|
setup-config
|
||||||
|
wasm-*-docs.tar.gz
|
||||||
@@ -154,7 +154,7 @@ getName = do
|
|||||||
putResultType :: ResultType -> Put
|
putResultType :: ResultType -> Put
|
||||||
putResultType [] = putWord8 0x40
|
putResultType [] = putWord8 0x40
|
||||||
putResultType [valType] = put valType
|
putResultType [valType] = put valType
|
||||||
putResultType _ = fail "Current WebAssembly spec does not support returning more then one value"
|
putResultType _ = error "Current WebAssembly spec does not support returning more then one value"
|
||||||
|
|
||||||
getResultType :: Get ResultType
|
getResultType :: Get ResultType
|
||||||
getResultType = do
|
getResultType = do
|
||||||
|
|||||||
@@ -903,11 +903,11 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
|
|||||||
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IXor) =
|
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IXor) =
|
||||||
return $ Done ctx { stack = VI64 (v1 `xor` v2) : rest }
|
return $ Done ctx { stack = VI64 (v1 `xor` v2) : rest }
|
||||||
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IShl) =
|
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IShl) =
|
||||||
return $ Done ctx { stack = VI64 (v1 `shiftL` (fromIntegral v2 `rem` 64)) : rest }
|
return $ Done ctx { stack = VI64 (v1 `shiftL` (fromIntegral (v2 `rem` 64))) : rest }
|
||||||
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IShrU) =
|
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IShrU) =
|
||||||
return $ Done ctx { stack = VI64 (v1 `shiftR` (fromIntegral v2 `rem` 64)) : rest }
|
return $ Done ctx { stack = VI64 (v1 `shiftR` (fromIntegral (v2 `rem` 64))) : rest }
|
||||||
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IShrS) =
|
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IShrS) =
|
||||||
return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 `shiftR` (fromIntegral v2 `rem` 64)) : rest }
|
return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 `shiftR` (fromIntegral (v2 `rem` 64))) : rest }
|
||||||
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRotl) =
|
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRotl) =
|
||||||
return $ Done ctx { stack = VI64 (v1 `rotateL` fromIntegral v2) : rest }
|
return $ Done ctx { stack = VI64 (v1 `rotateL` fromIntegral v2) : rest }
|
||||||
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRotr) =
|
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRotr) =
|
||||||
|
|||||||
@@ -194,12 +194,12 @@ runScript onAssertFail script = do
|
|||||||
runAssert st assert@(AssertInvalid moduleDef failureString) =
|
runAssert st assert@(AssertInvalid moduleDef failureString) =
|
||||||
let (_, m) = buildModule moduleDef in
|
let (_, m) = buildModule moduleDef in
|
||||||
case Validate.validate m of
|
case Validate.validate m of
|
||||||
Right _ -> onAssertFail "Invalid module pass validation" assert
|
Right _ -> onAssertFail "An invalid module passed validation step" assert
|
||||||
Left reason ->
|
Left reason ->
|
||||||
if failureString `elem` getFailureString reason
|
if failureString `elem` getFailureString reason
|
||||||
then return ()
|
then return ()
|
||||||
else
|
else
|
||||||
let msg = "Module invalid for other reason. Expected "
|
let msg = "Module is invalid for other reason. Expected "
|
||||||
++ show failureString
|
++ show failureString
|
||||||
++ ", but actual is "
|
++ ", but actual is "
|
||||||
++ show (getFailureString reason)
|
++ show (getFailureString reason)
|
||||||
|
|||||||
@@ -16,8 +16,8 @@ import qualified Data.Set as Set
|
|||||||
import Data.List (foldl')
|
import Data.List (foldl')
|
||||||
import qualified Data.Text.Lazy as TL
|
import qualified Data.Text.Lazy as TL
|
||||||
import Data.Maybe (fromMaybe, maybeToList, catMaybes)
|
import Data.Maybe (fromMaybe, maybeToList, catMaybes)
|
||||||
import Data.Monoid ((<>))
|
|
||||||
import Numeric.Natural (Natural)
|
import Numeric.Natural (Natural)
|
||||||
|
import Prelude hiding ((<>))
|
||||||
|
|
||||||
import Control.Monad (foldM)
|
import Control.Monad (foldM)
|
||||||
import Control.Monad.Reader (ReaderT, runReaderT, withReaderT, ask)
|
import Control.Monad.Reader (ReaderT, runReaderT, withReaderT, ask)
|
||||||
@@ -52,6 +52,10 @@ data ValidationError =
|
|||||||
|
|
||||||
type ValidationResult = Either ValidationError ()
|
type ValidationResult = Either ValidationError ()
|
||||||
|
|
||||||
|
-- semigroup definition for Either a b is in conflict with my ad-hoc instance
|
||||||
|
-- to keep an old code Prelude version is hidden and redefined locally
|
||||||
|
(<>) = mappend
|
||||||
|
|
||||||
instance Monoid ValidationResult where
|
instance Monoid ValidationResult where
|
||||||
mempty = Right ()
|
mempty = Right ()
|
||||||
mappend (Right ()) vr = vr
|
mappend (Right ()) vr = vr
|
||||||
|
|||||||
+2
-2
@@ -1,5 +1,5 @@
|
|||||||
name: wasm
|
name: wasm
|
||||||
version: 1.0.0
|
version: 1.0.1
|
||||||
author: Ilya Rezvov
|
author: Ilya Rezvov
|
||||||
maintainer: Ilya Rezvov <rezvov.ilya@gmail.com>
|
maintainer: Ilya Rezvov <rezvov.ilya@gmail.com>
|
||||||
license: MIT
|
license: MIT
|
||||||
@@ -64,7 +64,7 @@ library
|
|||||||
Paths_wasm
|
Paths_wasm
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable wasm
|
executable wasm-bin
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
hs-source-dirs: exec
|
hs-source-dirs: exec
|
||||||
build-depends:
|
build-depends:
|
||||||
|
|||||||
Reference in New Issue
Block a user