wasmslop

app/Gyehoek/Wasm/Syntax.hs

@@ -0,0 +1,125 @@
+module Gyehoek.Wasm.Syntax
+  ( Module(..)
+  , Type
+  , Import
+  , Tag
+  , Global
+  , Mem
+  , Table
+  , Func
+  , Data
+  , Elem
+  , Export
+  , Idx
+  , TypeIdx
+  , FuncIdx
+  , GlobalIdx
+  , TableIdx
+  , MemIdx
+  , TagIdx
+  , ElemIdx
+  , DataIdx
+  , LabelIdx
+  , LocalIdx
+  , FieldIdx
+  ) where
+
+import Data.Vector (Vector)
+import Data.Word (Word32)
+import Data.Binary
+import Data.Bits
+import Data.Int (Int8)
+import Data.Binary
+
+
+data Type
+data Import
+data Tag
+data Global
+data Mem
+data Table
+data Func
+data Data
+data Elem
+data Export
+
+type Idx = Word32
+newtype TypeIdx = MkType Idx
+newtype FuncIdx = MkFunc Idx
+newtype GlobalIdx = MkGlobal Idx
+newtype TableIdx = MkTable Idx
+newtype MemIdx = MkMem Idx
+newtype TagIdx = MkTag Idx
+newtype ElemIdx = MkElem Idx
+newtype DataIdx = MkData Idx
+newtype LabelIdx = MkLabel Idx
+newtype LocalIdx = MkLocal Idx
+newtype FieldIdx = MkField Idx
+
+data Module = MkModule
+  { types :: Vector Type
+  , imports :: Vector Import
+  , tags :: Vector Tag
+  , globals :: Vector Global
+  , mems :: Vector Mem
+  , tables :: Vector Table
+  , funcs :: Vector Func
+  , datas :: Vector Data
+  , elems :: Vector Elem
+  , start :: Maybe FuncIdx
+  , exports :: Vector Export
+  }
+
+
+
+getULEB128 :: (Integral a, Bits a) => Int -> Get a
+getULEB128 bitsBudget = do
+    if bitsBudget > 0 then return () else fail "integer representation too long"
+    val <- getWord8
+    if bitsBudget >= 7 || val .&. 0x7F < 1 `shiftL` bitsBudget then return () else fail "integer too large"
+    if not (testBit val 7)
+    then return $ fromIntegral val
+    else do
+        rest <- getULEB128 (bitsBudget - 7)
+        return $ (fromIntegral $ val .&. 0x7F) .|. (rest `shiftL` 7)
+
+putULEB128 :: (Integral a, Bits a) => a -> Put
+putULEB128 val =
+    if val < 128
+    then putWord8 $ fromIntegral val
+    else do
+        putWord8 $ 0x80 + (0x7F .&. fromIntegral val)
+        putULEB128 $ val `shiftR` 7
+
+getSLEB128 :: (Integral a, Bits a) => Int -> Get a
+getSLEB128 bitsBudget = do
+    if bitsBudget > 0 then return () else fail "integer representation too long"
+    let toInt8 :: Word8 -> Int8
+        toInt8 = fromIntegral
+    a <- getWord8
+    let mask = (0xFF `shiftL` (bitsBudget - 1)) .&. 0x7F
+    if bitsBudget >= 7 || a .&. mask == 0 || a .&. mask == mask then return () else fail "integer too large"
+    if not (testBit a 7)
+    then return . fromIntegral . toInt8 $ (a .&. 0x7f) .|. ((a .&. 0x40) `shiftL` 1)
+    else do
+        b <- getSLEB128 (bitsBudget - 7)
+        return $ (b `shiftL` 7) .|. (fromIntegral (a .&. 0x7f))
+
+putSLEB128 :: (Integral a, Bits a) => a -> Put
+putSLEB128 a = go a
+    where
+        ext = if a >= 0 then 0 else complement 0
+        go x = do
+            let 
+                r = x `shiftR` 7
+                w = x .&. 0x7f
+            if r /= ext
+            then do
+                putWord8 (fromIntegral w .|. 0x80)
+                go r
+            else
+                if (testBit w 6 && a < 0) || (not (testBit w 6) && a >= 0)
+                then putWord8 (fromIntegral w)
+                else do
+                    putWord8 (fromIntegral w .|. 0x80)
+                    putWord8 (fromIntegral ext .&. 0x7F)