implement sign-extension operators proposal

Author: SPY

src/Language/Wasm/Interpreter.hs

@@ -873,6 +873,16 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             return $ Done ctx { stack = VI32 (fromIntegral $ countTrailingZeros v) : rest }
         step ctx@EvalCtx{ stack = (VI32 v:rest) } (IUnOp BS32 IPopcnt) =
             return $ Done ctx { stack = VI32 (fromIntegral $ popCount v) : rest }
+        step ctx@EvalCtx{ stack = (VI32 v:rest) } (IUnOp BS32 IExtend8S) =
+            let byte = v .&. 0xFF in
+            let r = if byte >= 0x80 then asWord32 (fromIntegral byte - 0x100) else byte in
+            return $ Done ctx { stack = VI32 r : rest }
+        step ctx@EvalCtx{ stack = (VI32 v:rest) } (IUnOp BS32 IExtend16S) =
+            let half = v .&. 0xFFFF in
+            let r = if half >= 0x8000 then asWord32 (fromIntegral half - 0x10000) else half in
+            return $ Done ctx { stack = VI32 r : rest }
+        step ctx@EvalCtx{ stack = (VI32 v:rest) } (IUnOp BS32 IExtend32S) =
+            return $ Done ctx { stack = VI32 v : rest }
         step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IAdd) =
             return $ Done ctx { stack = VI64 (v1 + v2) : rest }
         step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 ISub) =
@@ -939,6 +949,18 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             return $ Done ctx { stack = VI64 (fromIntegral $ countTrailingZeros v) : rest }
         step ctx@EvalCtx{ stack = (VI64 v:rest) } (IUnOp BS64 IPopcnt) =
             return $ Done ctx { stack = VI64 (fromIntegral $ popCount v) : rest }
+        step ctx@EvalCtx{ stack = (VI64 v:rest) } (IUnOp BS64 IExtend8S) =
+            let byte = v .&. 0xFF in
+            let r = if byte >= 0x80 then asWord64 (fromIntegral byte - 0x100) else byte in
+            return $ Done ctx { stack = VI64 r : rest }
+        step ctx@EvalCtx{ stack = (VI64 v:rest) } (IUnOp BS64 IExtend16S) =
+            let quart = v .&. 0xFFFF in
+            let r = if quart >= 0x8000 then asWord64 (fromIntegral quart - 0x10000) else quart in
+            return $ Done ctx { stack = VI64 r : rest }
+        step ctx@EvalCtx{ stack = (VI64 v:rest) } (IUnOp BS64 IExtend32S) =
+            let half = v .&. 0xFFFFFFFF in
+            let r = if half >= 0x80000000 then asWord64 (fromIntegral half - 0x100000000) else half in
+            return $ Done ctx { stack = VI64 r : rest }
         step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FAbs) =
             return $ Done ctx { stack = VF32 (abs v) : rest }
         step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FNeg) =

src/Language/Wasm/Parser.y

@@ -165,6 +165,8 @@ import Language.Wasm.Lexer (
 'i32.clz'             { Lexeme _ (TKeyword "i32.clz") }
 'i32.ctz'             { Lexeme _ (TKeyword "i32.ctz") }
 'i32.popcnt'          { Lexeme _ (TKeyword "i32.popcnt") }
+'i32.extend8_s'       { Lexeme _ (TKeyword "i32.extend8_s") }
+'i32.extend16_s'      { Lexeme _ (TKeyword "i32.extend16_s") }
 'i32.add'             { Lexeme _ (TKeyword "i32.add") }
 'i32.sub'             { Lexeme _ (TKeyword "i32.sub") }
 'i32.mul'             { Lexeme _ (TKeyword "i32.mul") }
@@ -183,6 +185,9 @@ import Language.Wasm.Lexer (
 'i64.clz'             { Lexeme _ (TKeyword "i64.clz") }
 'i64.ctz'             { Lexeme _ (TKeyword "i64.ctz") }
 'i64.popcnt'          { Lexeme _ (TKeyword "i64.popcnt") }
+'i64.extend8_s'       { Lexeme _ (TKeyword "i64.extend8_s") }
+'i64.extend16_s'      { Lexeme _ (TKeyword "i64.extend16_s") }
+'i64.extend32_s'      { Lexeme _ (TKeyword "i64.extend32_s") }
 'i64.add'             { Lexeme _ (TKeyword "i64.add") }
 'i64.sub'             { Lexeme _ (TKeyword "i64.sub") }
 'i64.mul'             { Lexeme _ (TKeyword "i64.mul") }
@@ -443,6 +448,8 @@ plaininstr :: { PlainInstr }
     | 'i32.clz'                      { IUnOp BS32 IClz }
     | 'i32.ctz'                      { IUnOp BS32 ICtz }
     | 'i32.popcnt'                   { IUnOp BS32 IPopcnt }
+    | 'i32.extend8_s'                { IUnOp BS32 IExtend8S }
+    | 'i32.extend16_s'               { IUnOp BS32 IExtend16S }
     | 'i32.add'                      { IBinOp BS32 IAdd }
     | 'i32.sub'                      { IBinOp BS32 ISub }
     | 'i32.mul'                      { IBinOp BS32 IMul }
@@ -461,6 +468,9 @@ plaininstr :: { PlainInstr }
     | 'i64.clz'                      { IUnOp BS64 IClz }
     | 'i64.ctz'                      { IUnOp BS64 ICtz }
     | 'i64.popcnt'                   { IUnOp BS64 IPopcnt }
+    | 'i64.extend8_s'                { IUnOp BS64 IExtend8S }
+    | 'i64.extend16_s'               { IUnOp BS64 IExtend16S }
+    | 'i64.extend32_s'               { IUnOp BS64 IExtend32S }
     | 'i64.add'                      { IBinOp BS64 IAdd }
     | 'i64.sub'                      { IBinOp BS64 ISub }
     | 'i64.mul'                      { IBinOp BS64 IMul }

src/Language/Wasm/Structure.hs

@@ -57,7 +57,14 @@ import GHC.Generics (Generic)
 
 data BitSize = BS32 | BS64 deriving (Show, Eq, Generic, NFData)
 
-data IUnOp = IClz | ICtz | IPopcnt deriving (Show, Eq, Generic, NFData)
+data IUnOp =
+    IClz
+    | ICtz
+    | IPopcnt
+    | IExtend8S
+    | IExtend16S
+    | IExtend32S
+    deriving (Show, Eq, Generic, NFData)
 
 data IBinOp =
     IAdd