fix build and tests for ghc >8.6

This commit is contained in:
Ilya Rezvov
2020-01-13 21:56:06 -08:00
parent adeabf7e30
commit d7e1b803f5
6 changed files with 21 additions and 10 deletions
+7
View File
@@ -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
+1 -1
View File
@@ -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
+3 -3
View File
@@ -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) =
+2 -2
View File
@@ -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)
+5 -1
View File
@@ -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
View File
@@ -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: