diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index a0cc180..a4de5a8 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -9,7 +9,11 @@ module Language.Wasm.Parser ( import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLEncoding -import Numeric.Natural +import qualified Data.Text.Lazy.Read as TLRead + +import qualified Data.ByteString.Lazy as LBS +import Numeric.Natural (Natural) +import Data.Maybe (fromMaybe) import Language.Wasm.Lexer ( Token ( @@ -52,8 +56,35 @@ import Language.Wasm.Lexer ( 'return' { TKeyword "return" } 'call' { TKeyword "call" } 'call_indirect' { TKeyword "call_indirect" } +'drop' { TKeyword "drop" } +'select' { TKeyword "select" } +'get_local' { TKeyword "get_local" } +'set_local' { TKeyword "set_local" } +'tee_local' { TKeyword "tee_local" } +'get_global' { TKeyword "get_global" } +'set_global' { TKeyword "set_global" } +'i32.load' { TKeyword "i32.load" } +'i64.load' { TKeyword "i64.load" } +'f32.load' { TKeyword "f32.load" } +'f64.load' { TKeyword "f64.load" } +'i32.load8_s' { TKeyword "i32.load8_s" } +'i32.load8_u' { TKeyword "i32.load8_u" } +'i32.load16_s' { TKeyword "i32.load16_s" } +'i32.load16_u' { TKeyword "i32.load16_u" } +'i64.load8_s' { TKeyword "i64.load8_s" } +'i64.load8_u' { TKeyword "i64.load8_u" } +'i64.load16_s' { TKeyword "i64.load16_s" } +'i64.load16_u' { TKeyword "i64.load16_u" } +'i64.load32_s' { TKeyword "i64.load32_s" } +'i64.load32_u' { TKeyword "i64.load32_u" } +'i32.store' { TKeyword "i32.store" } +'i64.store' { TKeyword "i64.store" } +'f32.store' { TKeyword "f32.store" } +'f64.store' { TKeyword "f64.store" } id { TId $$ } u32 { TIntLit (asUInt32 -> Just $$) } +offset { TKeyword (asOffset -> Just $$) } +align { TKeyword (asAlign -> Just $$) } %% @@ -105,7 +136,14 @@ funcidx :: { FuncIndex } typeidx :: { TypeIndex } : u32 { $1 } +localidx :: { LocalIndex } + : u32 { $1 } + +globalidx :: { GlobalIndex } + : u32 { $1 } + plaininstr :: { PlainInstr } + -- control instructions : 'unreachable' { Unreachable } | 'nop' { Nop } | 'br' labelidx { Br $2 } @@ -114,6 +152,34 @@ plaininstr :: { PlainInstr } | 'return' { Return } | 'call' funcidx { Call $2 } | 'call_indirect' typeuse { CallIndirect $2 } + -- parametric instructions + | 'drop' { Drop } + | 'select' { Select } + -- variable instructions + | 'get_local' localidx { GetLocal $2 } + | 'set_local' localidx { SetLocal $2 } + | 'tee_local' localidx { TeeLocal $2 } + | 'get_global' globalidx { GetGlobal $2 } + | 'set_global' globalidx { SetGlobal $2 } + -- memory instructions + | 'i32.load' memarg4 { I32Load $2 } + | 'i64.load' memarg8 { I64Load $2 } + | 'f32.load' memarg4 { F32Load $2 } + | 'f64.load' memarg8 { F64Load $2 } + | 'i32.load8_s' memarg1 { I32Load8S $2 } + | 'i32.load8_u' memarg1 { I32Load8U $2 } + | 'i32.load16_s' memarg2 { I32Load16S $2 } + | 'i32.load16_u' memarg2 { I32Load16U $2 } + | 'i64.load8_s' memarg1 { I64Load8S $2 } + | 'i64.load8_u' memarg1 { I64Load8U $2 } + | 'i64.load16_s' memarg2 { I64Load16S $2 } + | 'i64.load16_u' memarg2 { I64Load16U $2 } + | 'i64.load32_s' memarg4 { I64Load32S $2 } + | 'i64.load32_u' memarg4 { I64Load32U $2 } + | 'i32.store' memarg4 { I32Store $2 } + | 'i64.store' memarg8 { I64Store $2 } + | 'f32.store' memarg4 { F32Store $2 } + | 'f64.store' memarg8 { F64Store $2 } typedef :: { TypeDef } : '(' 'type' opt(ident) functype ')' { TypeDef $3 $4 } @@ -123,6 +189,18 @@ typeuse :: { TypeUse } | '(' 'type' typeidx paramtypes resulttypes ')' { IndexedTypeUse $3 (Just $ FuncType $4 $5) } | paramtypes resulttypes { AnonimousTypeUse $ FuncType $1 $2 } +memarg1 :: { MemArg } + : opt(offset) opt(align) { MemArg (fromMaybe 0 $1) (fromMaybe 1 $2) } + +memarg2 :: { MemArg } + : opt(offset) opt(align) { MemArg (fromMaybe 0 $1) (fromMaybe 2 $2) } + +memarg4 :: { MemArg } + : opt(offset) opt(align) { MemArg (fromMaybe 0 $1) (fromMaybe 4 $2) } + +memarg8 :: { MemArg } + : opt(offset) opt(align) { MemArg (fromMaybe 0 $1) (fromMaybe 8 $2) } + -- utils rev_list(p) @@ -150,6 +228,19 @@ asUInt32 val | val >= 0, val < 2 ^ 32 = Just $ fromIntegral val | otherwise = Nothing +asOffset :: LBS.ByteString -> Maybe Natural +asOffset str = do + num <- TL.stripPrefix "offset=" $ TLEncoding.decodeUtf8 str + fromIntegral . fst <$> eitherToMaybe (TLRead.decimal num) + +asAlign :: LBS.ByteString -> Maybe Natural +asAlign str = do + num <- TL.stripPrefix "align=" $ TLEncoding.decodeUtf8 str + fromIntegral . fst <$> eitherToMaybe (TLRead.decimal num) + +eitherToMaybe :: Either left right -> Maybe right +eitherToMaybe = either (const Nothing) Just + data ValueType = I32 | I64 @@ -180,8 +271,11 @@ data TableType = TableType Limit ElemType deriving (Show, Eq) type LabelIndex = Natural type FuncIndex = Natural type TypeIndex = Natural +type LocalIndex = Natural +type GlobalIndex = Natural data PlainInstr = + -- Control instructions Unreachable | Nop | Br LabelIndex @@ -190,6 +284,34 @@ data PlainInstr = | Return | Call FuncIndex | CallIndirect TypeUse + -- Parametric instructions + | Drop + | Select + -- Variable instructions + | GetLocal LocalIndex + | SetLocal LocalIndex + | TeeLocal LocalIndex + | GetGlobal GlobalIndex + | SetGlobal GlobalIndex + -- Memory instructions + | I32Load MemArg + | I64Load MemArg + | F32Load MemArg + | F64Load MemArg + | I32Load8S MemArg + | I32Load8U MemArg + | I32Load16S MemArg + | I32Load16U MemArg + | I64Load8S MemArg + | I64Load8U MemArg + | I64Load16S MemArg + | I64Load16U MemArg + | I64Load32S MemArg + | I64Load32U MemArg + | I32Store MemArg + | I64Store MemArg + | F32Store MemArg + | F64Store MemArg deriving (Show, Eq) data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq) @@ -199,6 +321,8 @@ data TypeUse = | AnonimousTypeUse FuncType deriving (Show, Eq) +data MemArg = MemArg { offset :: Natural, align :: Natural } deriving (Show, Eq) + happyError tokens = error $ "Error occuried: " ++ show tokens } \ No newline at end of file