update text and binary parsers to new elem formats

src/Language/Wasm/Binary.hs

@@ -244,7 +244,13 @@ instance Serialize FuncType where
 
 instance Serialize ElemType where
     put FuncRef = putWord8 0x70
-    get = byteGuard 0x70 >> return FuncRef
+    put ExternRef = putWord8 0x6F
+    get = do
+        op <- getWord8
+        case op of
+            0x70 -> return FuncRef
+            0x69 -> return ExternRef
+            _ -> fail "unknown reference type"
 
 instance Serialize Limit where
     put (Limit min Nothing) = putWord8 0x00 >> putULEB128 min
@@ -793,11 +799,55 @@ instance Serialize Export where
     get = Export <$> getName <*> get
 
 instance Serialize ElemSegment where
-    put (ElemSegment tableIndex offset funcIndexes) = do
+    put (ElemSegment elemType Passive elements) = do
+        putWord8 0x05
+        put elemType
+        putVec $ map putExpression elements
+    put (ElemSegment elemType (Active tableIndex offset) elements) = do
+        putWord8 0x06
         putULEB128 tableIndex
         putExpression offset
-        putVec $ map Index funcIndexes
+        put elemType
-    get = ElemSegment <$> getULEB128 32 <*> getExpression <*> (map unIndex <$> getVec)
+        putVec $ map putExpression elements
+    put (ElemSegment elemType Declarative elements) = do
+        putWord8 0x07
+        put elemType
+        putVec $ map putExpression elements
+    get = do
+        op <- getWord8
+        let funcIndexes = map ((:[]) . RefFunc . unIndex) <$> getVec
+        let elemKind = byteGuard 0x00 >> return FuncRef
+        case op of
+            0x00 -> do
+                offset <- getExpression
+                ElemSegment FuncRef (Active 0 offset) <$> funcIndexes
+            0x01 -> do
+                elemType <- elemKind
+                ElemSegment elemType Passive <$> funcIndexes
+            0x02 -> do
+                tableIndex <- getULEB128 32
+                offset <- getExpression
+                elemType <- elemKind
+                ElemSegment elemType (Active tableIndex offset) <$> funcIndexes
+            0x03 -> do
+                elemType <- elemKind
+                ElemSegment elemType Declarative <$> funcIndexes
+            0x04 -> do
+                offset <- getExpression
+                ElemSegment FuncRef (Active 0 offset) <$> funcIndexes
+            0x05 -> do
+                elemType <- get
+                ElemSegment elemType Passive <$> getVec
+            0x06 -> do
+                tableIndex <- getULEB128 32
+                offset <- getExpression
+                elemType <- get
+                ElemSegment elemType (Active tableIndex offset) <$> getVec
+            0x07 -> do
+                elemType <- get
+                ElemSegment elemType Declarative <$> getVec
+            _ ->
+                fail "unknown element segment type"
 
 data LocalTypeRange = LocalTypeRange Natural ValueType deriving (Show, Eq)
 

src/Language/Wasm/Parser.y

@@ -318,6 +318,8 @@ import Language.Wasm.Lexer (
 'export'              { Lexeme _ (TKeyword "export") }
 'local'               { Lexeme _ (TKeyword "local") }
 'elem'                { Lexeme _ (TKeyword "elem") }
+'item'                { Lexeme _ (TKeyword "item") }
+'declare'             { Lexeme _ (TKeyword "declare") }
 'data'                { Lexeme _ (TKeyword "data") }
 'offset'              { Lexeme _ (TKeyword "offset") }
 'start'               { Lexeme _ (TKeyword "start") }
@@ -885,7 +887,10 @@ limits_elemtype_elem :: { Maybe Ident -> [ModuleField] }
         \ident ->
             let funcsLen = fromIntegral $ length $4 in [
                 MFTable $ Table [] ident $ TableType (Limit funcsLen (Just funcsLen)) $1,
-                MFElem $ ElemSegment (fromMaybe (Index 0) $ Named `fmap` ident) [PlainInstr $ I32Const 0] $4
+                let tableIndex = (fromMaybe (Index 0) $ Named `fmap` ident) in
+                let offset = [PlainInstr $ I32Const 0] in
+                let elements = funcIndexToExpr $4 in
+                MFElem $ ElemSegment Nothing FuncRef (Active tableIndex offset) elements
             ]
     }
     | '(' import_export_table { $2 }
@@ -916,15 +921,38 @@ export :: { Export }
 start :: { StartFunction }
     : 'start' index ')' { StartFunction $2 }
 
--- TODO: Spec from 09 Jan 2018 declares 'offset' keyword as mandatory,
--- but collection of testcases omits 'offset' in this position
--- I am going to support both options for now, but maybe it has to be updated in future.
 offsetexpr :: { [Instruction] }
     : 'offset' mixed_instruction_list(')') { snd $2 }
     | folded_instr1 { $1 }
 
-elemsegment :: { ElemSegment }
+elem :: { ElemSegment }
-    : 'elem' opt(index) '(' offsetexpr list(index) ')' { ElemSegment (fromMaybe (Index 0) $2) $4 $5 }
+    : 'elem' opt(ident) elem1 { $3{ ident = $2 } }
+
+elem1 :: { ElemSegment }
+    : elemlist ')' { let (t, els) = $1 in ElemSegment Nothing t Passive els }
+    | 'declare' elemlist ')' { let (t, els) = $2 in ElemSegment Nothing t Declarative els }
+    | '(' elem1_active { $2 }
+
+elem1_active :: { ElemSegment }
+    : 'table' index ')' '(' elem1_active_offset {
+        let (offset, t, els) = $5 in ElemSegment Nothing t (Active $2 offset) els
+    }
+    | elem1_active_offset {
+        let (offset, t, els) = $1 in ElemSegment Nothing t (Active (Index 0) offset) els
+    }
+
+elem1_active_offset :: { ([Instruction], ElemType, [[Instruction]]) }
+    : 'offset' mixed_instruction_list(')') elemlist { (snd $2, fst $3, snd $3) }
+    | folded_instr1 elemlist { ($1, fst $2, snd $2) }
+
+elemlist :: { (ElemType, [[Instruction]]) }
+    : 'func' list(index) { (FuncRef, funcIndexToExpr $2) }
+    | 'funcref' list(elemexpr) { (FuncRef, $2) }
+
+elemexpr :: { [Instruction] }
+    : plaininstr { [PlainInstr $1] }
+    | '(' 'item' mixed_instruction_list(')') { snd $3 }
+    | '(' folded_instr1 { $2 }
 
 datasegment :: { DataSegment }
     : 'data' opt(index) '(' offsetexpr datastring ')' { DataSegment (fromMaybe (Index 0) $2) $4 $5 }
@@ -934,7 +962,7 @@ modulefield1_single :: { ModuleField }
     | import { MFImport $1 }
     | export { MFExport $1 }
     | start { MFStart $1 }
-    | elemsegment { MFElem $1 }
+    | elem { MFElem $1 }
     | datasegment { MFData $1 }
     | function { $1 }
     | global { $1 }
@@ -1293,10 +1321,17 @@ data Export = Export {
 
 data StartFunction = StartFunction FuncIndex deriving (Show, Eq, Generic, NFData)
 
+data ElemMode
+    = Passive
+    | Active TableIndex [Instruction]
+    | Declarative
+    deriving (Show, Eq, Generic, NFData)
+
 data ElemSegment = ElemSegment {
-        tableIndex :: TableIndex,
+        ident :: Maybe Ident,
-        offset :: [Instruction],
+        elemType :: ElemType,
-        funcIndexes :: [FuncIndex]
+        mode :: ElemMode,
+        elements :: [[Instruction]]
     }
     deriving (Show, Eq, Generic, NFData)
 
@@ -1399,6 +1434,9 @@ constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const v
 constInstructionToValue (PlainInstr (RefNull et)) = S.RefNull et
 constInstructionToValue _ = error "Only const instructions supported as arguments for actions"
 
+funcIndexToExpr :: [FuncIndex] -> [[Instruction]]
+funcIndexToExpr = map $ (:[]) . PlainInstr . RefFunc
+
 desugarize :: [ModuleField] -> Either String S.Module
 desugarize fields = do
     checkImportsOrder fields
@@ -1484,8 +1522,6 @@ desugarize fields = do
             extractTypeDefFromInstructions (matchTypeUse defs funcType) body
         extractTypeDef defs (MFGlobal Global { initializer }) =
             extractTypeDefFromInstructions defs initializer
-        extractTypeDef defs (MFElem ElemSegment { offset }) =
-            extractTypeDefFromInstructions defs offset
         extractTypeDef defs (MFData DataSegment { offset }) =
             extractTypeDefFromInstructions defs offset
         extractTypeDef defs _ = defs
@@ -1905,12 +1941,18 @@ desugarize fields = do
 
         -- elem segment
         synElemToStruct :: Module -> ElemSegment -> Either String S.ElemSegment
-        synElemToStruct mod ElemSegment { tableIndex, offset, funcIndexes } =
+        synElemToStruct mod ElemSegment { ident, elemType, mode, elements } = do
-            let ctx = FunCtx mod [] [] [] in
+            let ctx = FunCtx mod [] [] []
-            let offsetInstrs = mapM (synInstrToStruct ctx) offset in
+            m <- case mode of {
-            let idx = fromJust $ getTableIndex mod tableIndex in
+                Active tableIndex offset ->
-            let indexes = map (fromJust . getFuncIndex mod) funcIndexes in
+                    let offsetInstrs = mapM (synInstrToStruct ctx) offset in
-            S.ElemSegment idx <$> offsetInstrs <*> return indexes
+                    let idx = fromJust $ getTableIndex mod tableIndex in
+                    S.Active idx <$> offsetInstrs;
+                Passive -> return S.Passive;
+                Declarative -> return S.Declarative
+            }
+            let elemExprs = mapM (mapM (synInstrToStruct ctx)) elements
+            S.ElemSegment elemType m <$> elemExprs
 
         extractElemSegment :: [ElemSegment] -> ModuleField -> [ElemSegment]
         extractElemSegment elems (MFElem elem) = elem : elems

src/Language/Wasm/Structure.hs

@@ -6,6 +6,7 @@ module Language.Wasm.Structure (
     Module(..),
     DataSegment(..),
     ElemSegment(..),
+    ElemMode(..),
     StartFunction(..),
     Export(..),
     ExportDesc(..),
@@ -228,10 +229,16 @@ data Global = Global {
     initializer :: Expression
 } deriving (Show, Eq, Generic, NFData)
 
+data ElemMode =
+    Passive
+    | Active TableIndex Expression
+    | Declarative
+    deriving (Show, Eq, Generic, NFData)
+
 data ElemSegment = ElemSegment {
-    tableIndex :: TableIndex,
+    elemType :: ElemType,
-    offset :: Expression,
+    mode :: ElemMode,
-    funcIndexes :: [FuncIndex]
+    elements :: [Expression]
 } deriving (Show, Eq, Generic, NFData)
 
 data DataSegment = DataSegment {

tests/Test.hs

@@ -17,7 +17,8 @@ import qualified Data.List as List
 main :: IO ()
 main = do
   files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec"
-  let files = ["ref_null.wast", "ref_is_null.wast"]
+  -- let files = ["ref_null.wast", "ref_is_null.wast"]
+  let files = ["elem.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do