add syntax support for extended data segments

src/Language/Wasm/Binary.hs

@@ -881,7 +881,7 @@ instance Serialize Function where
         return $ Function 0 locals body
 
 instance Serialize DataSegment where
-    put (DataSegment memIdx offset init) = do
+    put (DataSegment (ActiveData memIdx offset) init) = do
         putULEB128 memIdx
         putExpression offset
         putULEB128 $ LBS.length init
@@ -891,7 +891,7 @@ instance Serialize DataSegment where
         offset <- getExpression
         len <- getULEB128 32
         init <- getLazyByteString len
-        return $ DataSegment memIdx offset init
+        return $ DataSegment (ActiveData memIdx offset) init
 
 instance Serialize Module where
     put mod = do

src/Language/Wasm/Builder.hs

@@ -975,7 +975,7 @@ table min max = do
 dataSegment :: (Producer offset, OutType offset ~ Proxy I32) => offset -> LBS.ByteString -> GenMod ()
 dataSegment offset bytes =
     modify $ \(st@GenModState { target = m }) -> st {
-        target = m { datas = datas m ++ [DataSegment 0 (genExpr 0 (produce offset)) bytes] }
+        target = m { datas = datas m ++ [DataSegment (ActiveData 0 (genExpr 0 (produce offset))) bytes] }
     }
 
 asWord32 :: Int32 -> Word32

src/Language/Wasm/Interpreter.hs

@@ -571,7 +571,7 @@ initialize inst Module {elems, datas, start} = do
             Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
 
         checkData :: DataSegment -> Initialize (Int, MemoryStore, LBS.ByteString)
-        checkData DataSegment {memIndex, offset, chunk} = do
+        checkData DataSegment {dataMode = ActiveData memIndex offset, chunk} = do
             st <- State.get
             VI32 val <- liftIO $ evalConstExpr inst st offset
             let from = fromIntegral val
@@ -582,6 +582,8 @@ initialize inst Module {elems, datas, start} = do
             len <- ByteArray.getSizeofMutableByteArray mem
             Monad.when (last > len) $ throwError "data segment does not fit"
             return (from, mem, chunk)
+        checkData DataSegment {dataMode = ActiveData memIndex offset, chunk} =
+            error "passive data segments are not implemented yet"
         
         initData :: (Int, MemoryStore, LBS.ByteString) -> Initialize ()
         initData (from, mem, chunk) =

src/Language/Wasm/Parser.y

@@ -898,9 +898,11 @@ memory_limits_export_import1 :: { Maybe Ident -> [ModuleField] }
     | 'data' datastring ')' ')' {
         \ident ->
             let m = fromIntegral $ LBS.length $2 in
+            -- TODO: unhardcode memory index
+            let memIdx = fromMaybe (Index 0) $ Named `fmap` ident in
             [
                 MFMem $ Memory [] ident $ Limit m $ Just m,
-                MFData $ DataSegment (fromMaybe (Index 0) $ Named `fmap` ident) [PlainInstr $ I32Const 0] $2
+                MFData $ DataSegment Nothing (ActiveData memIdx [PlainInstr $ I32Const 0]) $2
             ]
     }
 
@@ -933,6 +935,7 @@ limits_elemtype_elem :: { Maybe Ident -> [ModuleField] }
         \ident ->
             let funcsLen = fromIntegral $ length $4 in [
                 MFTable $ Table [] ident $ TableType (Limit funcsLen (Just funcsLen)) $1,
+                -- TODO: unhardcode table index
                 let tableIndex = (fromMaybe (Index 0) $ Named `fmap` ident) in
                 let offset = [PlainInstr $ I32Const 0] in
                 let elements = $4 in
@@ -972,10 +975,6 @@ export :: { Export }
 start :: { StartFunction }
     : 'start' index ')' { StartFunction $2 }
 
-offsetexpr :: { [Instruction] }
-    : 'offset' mixed_instruction_list(')') { snd $2 }
-    | folded_instr1 { $1 }
-
 elem :: { ElemSegment }
     : 'elem' opt(ident) elem1 { $3{ ident = $2 } }
 
@@ -1007,8 +1006,20 @@ elemexpr :: { [Instruction] }
     | '(' 'item' mixed_instruction_list(')') { snd $3 }
     | '(' folded_instr1 { $2 }
 
+offsetexpr1 :: { [Instruction] }
+    : 'offset' mixed_instruction_list(')') { snd $2 }
+    | folded_instr1 { $1 }
+
+memory_offsetexpr1 :: { (MemoryIndex, [Instruction]) }
+    : offsetexpr1 { (Index 0, $1)}
+    | 'memory' index ')' '(' offsetexpr1 { ($2, $5) }
+
+memory_mode :: { DataMode }
+    : '(' memory_offsetexpr1 { uncurry ActiveData $2 }
+    | {- empty -} { PassiveData }
+
 datasegment :: { DataSegment }
-    : 'data' opt(index) '(' offsetexpr datastring ')' { DataSegment (fromMaybe (Index 0) $2) $4 $5 }
+    : 'data' opt(ident) memory_mode datastring ')' { DataSegment $2 $3 $4 }
 
 modulefield1_single :: { ModuleField }
     : typedef { MFType $1 }
@@ -1207,6 +1218,7 @@ type GlobalIndex = Index
 type TableIndex = Index
 type MemoryIndex = Index
 type ElemIndex = Index
+type DataIndex = Index
 
 data PlainInstr =
     -- Control instructions
@@ -1403,9 +1415,14 @@ data ElemSegment = ElemSegment {
     }
     deriving (Show, Eq)
 
+data DataMode =
+    PassiveData
+    | ActiveData MemoryIndex [Instruction]
+    deriving (Show, Eq)
+
 data DataSegment = DataSegment {
-        memIndex :: MemoryIndex,
+        ident :: Maybe Ident,
-        offset :: [Instruction],
+        dataMode :: DataMode,
         datastring :: LBS.ByteString
     }
     deriving (Show, Eq)
@@ -1591,8 +1608,6 @@ desugarize fields = do
             extractTypeDefFromInstructions (matchTypeUse defs funcType) body
         extractTypeDef defs (MFGlobal Global { initializer }) =
             extractTypeDefFromInstructions defs initializer
-        extractTypeDef defs (MFData DataSegment { offset }) =
-            extractTypeDefFromInstructions defs offset
         extractTypeDef defs _ = defs
 
         extractTypeDefFromInstructions :: [TypeDef] -> [Instruction] -> [TypeDef]
@@ -2089,11 +2104,17 @@ desugarize fields = do
 
         -- data segment
         synDataToStruct :: Module -> DataSegment -> Either String S.DataSegment
-        synDataToStruct mod DataSegment { memIndex, offset, datastring } =
+        synDataToStruct mod DataSegment { dataMode, datastring } = do
-            let ctx = FunCtx mod [] [] [] in
+            m <- case dataMode of
-            let offsetInstrs = mapM (synInstrToStruct ctx) offset in
+                PassiveData -> return S.PassiveData
-            let idx = fromJust $ getMemIndex mod memIndex in
+                ActiveData memIndex offset -> do
-            S.DataSegment idx <$> offsetInstrs <*> return datastring
+                    let ctx = FunCtx mod [] [] []
+                    offsetInstrs <- mapM (synInstrToStruct ctx) offset
+                    idx <- case getMemIndex mod memIndex of
+                        Just idx -> return idx
+                        Nothing -> throwError "unknown memory"
+                    return $ S.ActiveData idx offsetInstrs
+            return $ S.DataSegment m datastring
 
         extractDataSegment :: [DataSegment] -> ModuleField -> [DataSegment]
         extractDataSegment datas (MFData dataSegment) = dataSegment : datas

src/Language/Wasm/Structure.hs

@@ -4,6 +4,7 @@
 
 module Language.Wasm.Structure (
     Module(..),
+    DataMode(..),
     DataSegment(..),
     ElemSegment(..),
     ElemMode(..),
@@ -103,6 +104,7 @@ type LocalIndex = Natural
 type GlobalIndex = Natural
 type MemoryIndex = Natural
 type TableIndex = Natural
+type DataIndex = Natural
 type ElemIndex = Natural
 
 data ValueType =
@@ -252,9 +254,13 @@ data ElemSegment = ElemSegment {
     elements :: [Expression]
 } deriving (Show, Eq, Generic, NFData)
 
+data DataMode =
+    PassiveData
+    | ActiveData MemoryIndex Expression
+    deriving (Show, Eq, Generic, NFData)
+
 data DataSegment = DataSegment {
-    memIndex :: MemoryIndex,
+    dataMode :: DataMode,
-    offset :: Expression,
     chunk :: LBS.ByteString
 } deriving (Show, Eq, Generic, NFData)
 

src/Language/Wasm/Validate.hs

@@ -700,7 +700,7 @@ datasShouldBeValid m@Module { datas, mems, imports } =
     foldMap (isDataValid ctx) datas
     where
         isDataValid :: Ctx -> DataSegment -> ValidationResult
-        isDataValid ctx (DataSegment memIdx offset _) =
+        isDataValid ctx (DataSegment (ActiveData memIdx offset) _) =
             let check = runChecker ctx $ do
                     isConstExpression offset
                     t <- getExpressionType offset

tests/Test.hs

@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["select.wast"]
+  let files = ["data.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do