msyds/haskell-wasm
1
0
Fork 0
forked from GitHub/haskell-wasm
Code Pull Requests Activity
Files
0b593a4a8ce981245521f3904a14b9021193595c
haskell-wasm/src/Language/Wasm/Parser.y
T
Ilya Rezvov 0b593a4a8c fix block, loop and if folded forms parsing
2018-01-22 18:39:53 -08:00

1253 lines
44 KiB
Plaintext
Raw Blame History

{
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Language.Wasm.Parser (
parseModule
) where
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLEncoding
import qualified Data.Text.Lazy.Read as TLRead
import qualified Data.ByteString.Lazy as LBS
import Data.Maybe (fromMaybe)
import Data.List (foldl')
import Numeric.Natural (Natural)
import Language.Wasm.Lexer (
Token (
TKeyword,
TIntLit,
TFloatLit,
TStringLit,
TId,
TOpenBracket,
TCloseBracket,
TReserved,
EOF
),
Lexeme(..),
AlexPosn(..)
)
import Debug.Trace as Debug
}
%name parseModule mod
%tokentype { Lexeme }
%token
'(' { Lexeme _ TOpenBracket }
')' { Lexeme _ TCloseBracket }
'func' { Lexeme _ (TKeyword "func") }
'param' { Lexeme _ (TKeyword "param") }
'result' { Lexeme _ (TKeyword "result") }
'i32' { Lexeme _ (TKeyword "i32") }
'i64' { Lexeme _ (TKeyword "i64") }
'f32' { Lexeme _ (TKeyword "f32") }
'f64' { Lexeme _ (TKeyword "f64") }
'mut' { Lexeme _ (TKeyword "mut") }
'anyfunc' { Lexeme _ (TKeyword "anyfunc") }
'type' { Lexeme _ (TKeyword "type") }
'unreachable' { Lexeme _ (TKeyword "unreachable") }
'nop' { Lexeme _ (TKeyword "nop") }
'br' { Lexeme _ (TKeyword "br") }
'br_if' { Lexeme _ (TKeyword "br_if") }
'br_table' { Lexeme _ (TKeyword "br_table") }
'return' { Lexeme _ (TKeyword "return") }
'call' { Lexeme _ (TKeyword "call") }
'call_indirect' { Lexeme _ (TKeyword "call_indirect") }
'drop' { Lexeme _ (TKeyword "drop") }
'select' { Lexeme _ (TKeyword "select") }
'get_local' { Lexeme _ (TKeyword "get_local") }
'set_local' { Lexeme _ (TKeyword "set_local") }
'tee_local' { Lexeme _ (TKeyword "tee_local") }
'get_global' { Lexeme _ (TKeyword "get_global") }
'set_global' { Lexeme _ (TKeyword "set_global") }
'i32.load' { Lexeme _ (TKeyword "i32.load") }
'i64.load' { Lexeme _ (TKeyword "i64.load") }
'f32.load' { Lexeme _ (TKeyword "f32.load") }
'f64.load' { Lexeme _ (TKeyword "f64.load") }
'i32.load8_s' { Lexeme _ (TKeyword "i32.load8_s") }
'i32.load8_u' { Lexeme _ (TKeyword "i32.load8_u") }
'i32.load16_s' { Lexeme _ (TKeyword "i32.load16_s") }
'i32.load16_u' { Lexeme _ (TKeyword "i32.load16_u") }
'i64.load8_s' { Lexeme _ (TKeyword "i64.load8_s") }
'i64.load8_u' { Lexeme _ (TKeyword "i64.load8_u") }
'i64.load16_s' { Lexeme _ (TKeyword "i64.load16_s") }
'i64.load16_u' { Lexeme _ (TKeyword "i64.load16_u") }
'i64.load32_s' { Lexeme _ (TKeyword "i64.load32_s") }
'i64.load32_u' { Lexeme _ (TKeyword "i64.load32_u") }
'i32.store' { Lexeme _ (TKeyword "i32.store") }
'i64.store' { Lexeme _ (TKeyword "i64.store") }
'f32.store' { Lexeme _ (TKeyword "f32.store") }
'f64.store' { Lexeme _ (TKeyword "f64.store") }
'i32.store8' { Lexeme _ (TKeyword "i32.store8") }
'i32.store16' { Lexeme _ (TKeyword "i32.store16") }
'i64.store8' { Lexeme _ (TKeyword "i64.store") }
'i64.store16' { Lexeme _ (TKeyword "i64.store") }
'i64.store32' { Lexeme _ (TKeyword "i64.store") }
'current_memory' { Lexeme _ (TKeyword "current_memory") }
'grow_memory' { Lexeme _ (TKeyword "grow_memory") }
'i32.const' { Lexeme _ (TKeyword "i32.const") }
'i64.const' { Lexeme _ (TKeyword "i64.const") }
'f32.const' { Lexeme _ (TKeyword "f32.const") }
'f64.const' { Lexeme _ (TKeyword "f64.const") }
'i32.clz' { Lexeme _ (TKeyword "i32.clz") }
'i32.ctz' { Lexeme _ (TKeyword "i32.ctz") }
'i32.popcnt' { Lexeme _ (TKeyword "i32.popcnt") }
'i32.add' { Lexeme _ (TKeyword "i32.add") }
'i32.sub' { Lexeme _ (TKeyword "i32.sub") }
'i32.mul' { Lexeme _ (TKeyword "i32.mul") }
'i32.div_s' { Lexeme _ (TKeyword "i32.div_s") }
'i32.div_u' { Lexeme _ (TKeyword "i32.div_u") }
'i32.rem_s' { Lexeme _ (TKeyword "i32.rem_s") }
'i32.rem_u' { Lexeme _ (TKeyword "i32.rem_u") }
'i32.and' { Lexeme _ (TKeyword "i32.and") }
'i32.or' { Lexeme _ (TKeyword "i32.or") }
'i32.xor' { Lexeme _ (TKeyword "i32.xor") }
'i32.shl' { Lexeme _ (TKeyword "i32.shl") }
'i32.shr_s' { Lexeme _ (TKeyword "i32.shr_s") }
'i32.shr_u' { Lexeme _ (TKeyword "i32.shr_u") }
'i32.rotl' { Lexeme _ (TKeyword "i32.rotl") }
'i32.rotr' { Lexeme _ (TKeyword "i32.rotr") }
'i64.clz' { Lexeme _ (TKeyword "i64.clz") }
'i64.ctz' { Lexeme _ (TKeyword "i64.ctz") }
'i64.popcnt' { Lexeme _ (TKeyword "i64.popcnt") }
'i64.add' { Lexeme _ (TKeyword "i64.add") }
'i64.sub' { Lexeme _ (TKeyword "i64.sub") }
'i64.mul' { Lexeme _ (TKeyword "i64.mul") }
'i64.div_s' { Lexeme _ (TKeyword "i64.div_s") }
'i64.div_u' { Lexeme _ (TKeyword "i64.div_u") }
'i64.rem_s' { Lexeme _ (TKeyword "i64.rem_s") }
'i64.rem_u' { Lexeme _ (TKeyword "i64.rem_u") }
'i64.and' { Lexeme _ (TKeyword "i64.and") }
'i64.or' { Lexeme _ (TKeyword "i64.or") }
'i64.xor' { Lexeme _ (TKeyword "i64.xor") }
'i64.shl' { Lexeme _ (TKeyword "i64.shl") }
'i64.shr_s' { Lexeme _ (TKeyword "i64.shr_s") }
'i64.shr_u' { Lexeme _ (TKeyword "i64.shr_u") }
'i64.rotl' { Lexeme _ (TKeyword "i64.rotl") }
'i64.rotr' { Lexeme _ (TKeyword "i64.rotr") }
'f32.abs' { Lexeme _ (TKeyword "f32.abs") }
'f32.neg' { Lexeme _ (TKeyword "f32.neg") }
'f32.ceil' { Lexeme _ (TKeyword "f32.ceil") }
'f32.floor' { Lexeme _ (TKeyword "f32.floor") }
'f32.trunc' { Lexeme _ (TKeyword "f32.trunc") }
'f32.nearest' { Lexeme _ (TKeyword "f32.nearest") }
'f32.sqrt' { Lexeme _ (TKeyword "f32.sqrt") }
'f32.add' { Lexeme _ (TKeyword "f32.add") }
'f32.sub' { Lexeme _ (TKeyword "f32.sub") }
'f32.mul' { Lexeme _ (TKeyword "f32.mul") }
'f32.div' { Lexeme _ (TKeyword "f32.div") }
'f32.min' { Lexeme _ (TKeyword "f32.min") }
'f32.max' { Lexeme _ (TKeyword "f32.max") }
'f32.copysign' { Lexeme _ (TKeyword "f32.copysign") }
'f64.abs' { Lexeme _ (TKeyword "f64.abs") }
'f64.neg' { Lexeme _ (TKeyword "f64.neg") }
'f64.ceil' { Lexeme _ (TKeyword "f64.ceil") }
'f64.floor' { Lexeme _ (TKeyword "f64.floor") }
'f64.trunc' { Lexeme _ (TKeyword "f64.trunc") }
'f64.nearest' { Lexeme _ (TKeyword "f64.nearest") }
'f64.sqrt' { Lexeme _ (TKeyword "f64.sqrt") }
'f64.add' { Lexeme _ (TKeyword "f64.add") }
'f64.sub' { Lexeme _ (TKeyword "f64.sub") }
'f64.mul' { Lexeme _ (TKeyword "f64.mul") }
'f64.div' { Lexeme _ (TKeyword "f64.div") }
'f64.min' { Lexeme _ (TKeyword "f64.min") }
'f64.max' { Lexeme _ (TKeyword "f64.max") }
'f64.copysign' { Lexeme _ (TKeyword "f64.copysign") }
'i32.eqz' { Lexeme _ (TKeyword "i32.eqz") }
'i32.eq' { Lexeme _ (TKeyword "i32.eq") }
'i32.ne' { Lexeme _ (TKeyword "i32.ne") }
'i32.lt_s' { Lexeme _ (TKeyword "i32.lt_s") }
'i32.lt_u' { Lexeme _ (TKeyword "i32.lt_u") }
'i32.gt_s' { Lexeme _ (TKeyword "i32.gt_s") }
'i32.gt_u' { Lexeme _ (TKeyword "i32.gt_u") }
'i32.le_s' { Lexeme _ (TKeyword "i32.le_s") }
'i32.le_u' { Lexeme _ (TKeyword "i32.le_u") }
'i32.ge_s' { Lexeme _ (TKeyword "i32.ge_s") }
'i32.ge_u' { Lexeme _ (TKeyword "i32.ge_u") }
'i64.eqz' { Lexeme _ (TKeyword "i64.eqz") }
'i64.eq' { Lexeme _ (TKeyword "i64.eq") }
'i64.ne' { Lexeme _ (TKeyword "i64.ne") }
'i64.lt_s' { Lexeme _ (TKeyword "i64.lt_s") }
'i64.lt_u' { Lexeme _ (TKeyword "i64.lt_u") }
'i64.gt_s' { Lexeme _ (TKeyword "i64.gt_s") }
'i64.gt_u' { Lexeme _ (TKeyword "i64.gt_u") }
'i64.le_s' { Lexeme _ (TKeyword "i64.le_s") }
'i64.le_u' { Lexeme _ (TKeyword "i64.le_u") }
'i64.ge_s' { Lexeme _ (TKeyword "i64.ge_s") }
'i64.ge_u' { Lexeme _ (TKeyword "i64.ge_u") }
'f32.eq' { Lexeme _ (TKeyword "f32.eq") }
'f32.ne' { Lexeme _ (TKeyword "f32.ne") }
'f32.lt' { Lexeme _ (TKeyword "f32.lt") }
'f32.gt' { Lexeme _ (TKeyword "f32.gt") }
'f32.le' { Lexeme _ (TKeyword "f32.le") }
'f32.ge' { Lexeme _ (TKeyword "f32.ge") }
'f64.eq' { Lexeme _ (TKeyword "f64.eq") }
'f64.ne' { Lexeme _ (TKeyword "f64.ne") }
'f64.lt' { Lexeme _ (TKeyword "f64.lt") }
'f64.gt' { Lexeme _ (TKeyword "f64.gt") }
'f64.le' { Lexeme _ (TKeyword "f64.le") }
'f64.ge' { Lexeme _ (TKeyword "f64.ge") }
'i32.wrap/i64' { Lexeme _ (TKeyword "i32.wrap/i64") }
'i32.trunc_s/f32' { Lexeme _ (TKeyword "i32.trunc_s/f32") }
'i32.trunc_u/f32' { Lexeme _ (TKeyword "i32.trunc_u/f32") }
'i32.trunc_s/f64' { Lexeme _ (TKeyword "i32.trunc_s/f64") }
'i32.trunc_u/f64' { Lexeme _ (TKeyword "i32.trunc_u/f64") }
'i64.extend_s/i32' { Lexeme _ (TKeyword "i64.extend_s/i32") }
'i64.extend_u/i32' { Lexeme _ (TKeyword "i64.extend_u/i32") }
'i64.trunc_s/f32' { Lexeme _ (TKeyword "i64.trunc_s/f32") }
'i64.trunc_u/f32' { Lexeme _ (TKeyword "i64.trunc_u/f32") }
'i64.trunc_s/f64' { Lexeme _ (TKeyword "i64.trunc_s/f64") }
'i64.trunc_u/f64' { Lexeme _ (TKeyword "i64.trunc_u/f64") }
'f32.convert_s/i32' { Lexeme _ (TKeyword "f32.convert_s/i32") }
'f32.convert_u/i32' { Lexeme _ (TKeyword "f32.convert_u/i32") }
'f32.convert_s/i64' { Lexeme _ (TKeyword "f32.convert_s/i64") }
'f32.convert_u/i64' { Lexeme _ (TKeyword "f32.convert_u/i64") }
'f32.demote/f64' { Lexeme _ (TKeyword "f32.demote/f64") }
'f64.convert_s/i32' { Lexeme _ (TKeyword "f64.convert_s/i32") }
'f64.convert_u/i32' { Lexeme _ (TKeyword "f64.convert_u/i32") }
'f64.convert_s/i64' { Lexeme _ (TKeyword "f64.convert_s/i64") }
'f64.convert_u/i64' { Lexeme _ (TKeyword "f64.convert_u/i64") }
'f64.promote/f32' { Lexeme _ (TKeyword "f64.promote/f32") }
'i32.reinterpret/f32' { Lexeme _ (TKeyword "i32.reinterpret/f32") }
'i64.reinterpret/f64' { Lexeme _ (TKeyword "i64.reinterpret/f64") }
'f32.reinterpret/i32' { Lexeme _ (TKeyword "f32.reinterpret/i32") }
'f64.reinterpret/i64' { Lexeme _ (TKeyword "f64.reinterpret/i64") }
'block' { Lexeme _ (TKeyword "block") }
'loop' { Lexeme _ (TKeyword "loop") }
'if' { Lexeme _ (TKeyword "if") }
'else' { Lexeme _ (TKeyword "else") }
'end' { Lexeme _ (TKeyword "end") }
'then' { Lexeme _ (TKeyword "then") }
'table' { Lexeme _ (TKeyword "table") }
'memory' { Lexeme _ (TKeyword "memory") }
'global' { Lexeme _ (TKeyword "global") }
'import' { Lexeme _ (TKeyword "import") }
'export' { Lexeme _ (TKeyword "export") }
'local' { Lexeme _ (TKeyword "local") }
'elem' { Lexeme _ (TKeyword "elem") }
'data' { Lexeme _ (TKeyword "data") }
'offset' { Lexeme _ (TKeyword "offset") }
'start' { Lexeme _ (TKeyword "start") }
'module' { Lexeme _ (TKeyword "module") }
id { Lexeme _ (TId $$) }
u32 { Lexeme _ (TIntLit (asUInt32 -> Just $$)) }
i32 { Lexeme _ (TIntLit (asInt32 -> Just $$)) }
i64 { Lexeme _ (TIntLit (asInt64 -> Just $$)) }
f32 { Lexeme _ (TFloatLit (asFloat32 -> $$)) }
f64 { Lexeme _ (TFloatLit (asFloat64 -> $$)) }
offset { Lexeme _ (TKeyword (asOffset -> Just $$)) }
align { Lexeme _ (TKeyword (asAlign -> Just $$)) }
name { Lexeme _ (TStringLit (asName -> Just $$)) }
string { Lexeme _ (TStringLit (asString -> Just $$)) }
EOF { Lexeme _ EOF }
%%
functype :: { FuncType }
: '(' 'func' params_results { $3 }
params_results :: { FuncType }
: ')' { FuncType [] [] }
| '(' paramsresultstypeuse ')' { $2 }
ident :: { Ident }
: id { Ident (TL.toStrict (TLEncoding.decodeUtf8 $1)) }
valtype :: { ValueType }
: 'i32' { I32 }
| 'i64' { I64 }
| 'f32' { F32 }
| 'f64' { F64 }
globaltype :: { GlobalType }
: valtype { Const $1 }
| '(' 'mut' valtype ')' { Mut $3 }
labelidx :: { LabelIndex }
: u32 { Index $1 }
| ident { Named $1 }
funcidx :: { FuncIndex }
: u32 { Index $1 }
| ident { Named $1 }
typeidx :: { TypeIndex }
: u32 { Index $1 }
| ident { Named $1 }
localidx :: { LocalIndex }
: u32 { Index $1 }
| ident { Named $1 }
globalidx :: { GlobalIndex }
: u32 { Index $1 }
| ident { Named $1 }
tableidx :: { TableIndex }
: u32 { Index $1 }
| ident { Named $1 }
memidx :: { MemoryIndex }
: u32 { Index $1 }
| ident { Named $1 }
int32 :: { Integer }
: u32 { fromIntegral $1 }
| i32 { $1 }
int64 :: { Integer }
: u32 { fromIntegral $1 }
| i32 { $1 }
| i64 { $1 }
float32 :: { Float }
: u32 { fromIntegral $1 }
| i32 { fromIntegral $1 }
| f32 { $1 }
float64 :: { Double }
: u32 { fromIntegral $1 }
| i32 { fromIntegral $1 }
| f32 { realToFrac $1 }
| f64 { realToFrac $1 }
plaininstr :: { PlainInstr }
-- control instructions
: 'unreachable' { Unreachable }
| 'nop' { Nop }
| 'br' labelidx { Br $2 }
| 'br_if' labelidx { BrIf $2 }
| 'br_table' rev_list1(labelidx) { BrTable (reverse $ tail $2) (head $2) }
| 'return' { Return }
| 'call' funcidx { Call $2 }
-- | 'call_indirect' typeuse { CallIndirect $2 }
-- call_inderict has special case in folded form
-- 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 }
| 'i32.store8' memarg1 { I32Store8 $2 }
| 'i32.store16' memarg2 { I32Store16 $2 }
| 'i64.store8' memarg1 { I64Store8 $2 }
| 'i64.store16' memarg2 { I64Store16 $2 }
| 'i64.store32' memarg4 { I64Store32 $2 }
| 'current_memory' { CurrentMemory }
| 'grow_memory' { GrowMemory }
-- numeric instructions
| 'i32.const' int32 { I32Const $2 }
| 'i64.const' int64 { I64Const $2 }
| 'f32.const' float32 { F32Const $2 }
| 'f64.const' float64 { F64Const $2 }
| 'i32.clz' { I32Clz }
| 'i32.ctz' { I32Ctz }
| 'i32.popcnt' { I32Popcnt }
| 'i32.add' { I32Add }
| 'i32.sub' { I32Sub }
| 'i32.mul' { I32Mul }
| 'i32.div_s' { I32DivS }
| 'i32.div_u' { I32DivU }
| 'i32.rem_s' { I32RemS }
| 'i32.rem_u' { I32RemU }
| 'i32.and' { I32And }
| 'i32.or' { I32Or }
| 'i32.xor' { I32Xor }
| 'i32.shl' { I32Shl }
| 'i32.shr_s' { I32ShrS }
| 'i32.shr_u' { I32ShrU }
| 'i32.rotl' { I32Rotl }
| 'i32.rotr' { I32Rotr }
| 'i64.clz' { I64Clz }
| 'i64.ctz' { I64Ctz }
| 'i64.popcnt' { I64Popcnt }
| 'i64.add' { I64Add }
| 'i64.sub' { I64Sub }
| 'i64.mul' { I64Mul }
| 'i64.div_s' { I64DivS }
| 'i64.div_u' { I64DivU }
| 'i64.rem_s' { I64RemS }
| 'i64.rem_u' { I64RemU }
| 'i64.and' { I64And }
| 'i64.or' { I64Or }
| 'i64.xor' { I64Xor }
| 'i64.shl' { I64Shl }
| 'i64.shr_s' { I64ShrS }
| 'i64.shr_u' { I64ShrU }
| 'i64.rotl' { I64Rotl }
| 'i64.rotr' { I64Rotr }
| 'f32.abs' { F32Abs }
| 'f32.neg' { F32Neg }
| 'f32.ceil' { F32Ceil }
| 'f32.floor' { F32Floor }
| 'f32.trunc' { F32Trunc }
| 'f32.nearest' { F32Nearest }
| 'f32.sqrt' { F32Sqrt }
| 'f32.add' { F32Add }
| 'f32.sub' { F32Sub }
| 'f32.mul' { F32Mul }
| 'f32.div' { F32Div }
| 'f32.min' { F32Min }
| 'f32.max' { F32Max }
| 'f32.copysign' { F32Copysign }
| 'f64.abs' { F64Abs }
| 'f64.neg' { F64Neg }
| 'f64.ceil' { F64Ceil }
| 'f64.floor' { F64Floor }
| 'f64.trunc' { F64Trunc }
| 'f64.nearest' { F64Nearest }
| 'f64.sqrt' { F64Sqrt }
| 'f64.add' { F64Add }
| 'f64.sub' { F64Sub }
| 'f64.mul' { F64Mul }
| 'f64.div' { F64Div }
| 'f64.min' { F64Min }
| 'f64.max' { F64Max }
| 'f64.copysign' { F64Copysign }
| 'i32.eqz' { I32Eqz }
| 'i32.eq' { I32Eq }
| 'i32.ne' { I32Ne }
| 'i32.lt_s' { I32LtS }
| 'i32.lt_u' { I32LtU }
| 'i32.gt_s' { I32GtS }
| 'i32.gt_u' { I32GtU }
| 'i32.le_s' { I32LeS }
| 'i32.le_u' { I32LeU }
| 'i32.ge_s' { I32GeS }
| 'i32.ge_u' { I32GeU }
| 'i64.eqz' { I64Eqz }
| 'i64.eq' { I64Eq }
| 'i64.ne' { I64Ne }
| 'i64.lt_s' { I64LtS }
| 'i64.lt_u' { I64LtU }
| 'i64.gt_s' { I64GtS }
| 'i64.gt_u' { I64GtU }
| 'i64.le_s' { I64LeS }
| 'i64.le_u' { I64LeU }
| 'i64.ge_s' { I64GeS }
| 'i64.ge_u' { I64GeU }
| 'f32.eq' { F32Eq }
| 'f32.ne' { F32Ne }
| 'f32.lt' { F32Lt }
| 'f32.gt' { F32Gt }
| 'f32.le' { F32Le }
| 'f32.ge' { F32Ge }
| 'f64.eq' { F64Eq }
| 'f64.ne' { F64Ne }
| 'f64.lt' { F64Lt }
| 'f64.gt' { F64Gt }
| 'f64.le' { F64Le }
| 'f64.ge' { F64Ge }
| 'i32.wrap/i64' { I32WrapI64 }
| 'i32.trunc_s/f32' { I32TruncSF32 }
| 'i32.trunc_u/f32' { I32TruncUF32 }
| 'i32.trunc_s/f64' { I32TruncSF64 }
| 'i32.trunc_u/f64' { I32TruncUF64 }
| 'i64.extend_s/i32' { I64ExtendSI32 }
| 'i64.extend_u/i32' { I64ExtendUI32 }
| 'i64.trunc_s/f32' { I64TruncSF32 }
| 'i64.trunc_u/f32' { I64TruncUF32 }
| 'i64.trunc_s/f64' { I64TruncSF64 }
| 'i64.trunc_u/f64' { I64TruncUF64 }
| 'f32.convert_s/i32' { F32ConvertSI32 }
| 'f32.convert_u/i32' { F32ConvertUI32 }
| 'f32.convert_s/i64' { F32ConvertSI64 }
| 'f32.convert_u/i64' { F32ConvertUI64 }
| 'f32.demote/f64' { F32DemoteF64 }
| 'f64.convert_s/i32' { F64ConvertSI32 }
| 'f64.convert_u/i32' { F64ConvertUI32 }
| 'f64.convert_s/i64' { F64ConvertSI64 }
| 'f64.convert_u/i64' { F64ConvertUI64 }
| 'f64.promote/f32' { F64PromoteF32 }
| 'i32.reinterpret/f32' { I32ReinterpretF32 }
| 'i64.reinterpret/f64' { I64ReinterpretF64 }
| 'f32.reinterpret/i32' { F32ReinterpretI32 }
| 'f64.reinterpret/i64' { F64ReinterpretI64 }
typedef :: { TypeDef }
: 'type' opt(ident) functype ')' { TypeDef $2 $3 }
-- TODO: it does not properly handle call_indirect instruction use. it expects to be last expression before common ')'
typeuse :: { TypeUse }
: '(' typeuse1 { $2 }
| {- empty -} { AnonimousTypeUse $ FuncType [] [] }
typeuse1 :: { TypeUse }
: 'type' typeidx ')' typedtypeuse { IndexedTypeUse $2 $4 }
| paramsresultstypeuse { AnonimousTypeUse $1 }
typedtypeuse :: { Maybe FuncType }
: '(' paramsresultstypeuse { Just $2 }
| {- empty -} { Nothing }
paramsresultstypeuse :: { FuncType }
: paramsresultstypeuse '(' paramsresulttypeuse { mergeFuncType $1 $3 }
| paramsresulttypeuse { $1 }
paramsresulttypeuse :: { FuncType }
: 'param' list(valtype) ')' { FuncType (map (ParamType Nothing) $2) [] }
| 'param' ident valtype ')' { FuncType [ParamType (Just $2) $3] [] }
| 'result' list(valtype) ')' { FuncType [] $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) }
resulttype :: { [ValueType] }
: '(' 'result' list(valtype) ')' { $3 }
instr :: { Instruction }
: plaininstr { PlainInstr $1 }
-- TODO: check if optional labels are equal if they exist
| 'block' opt(ident) opt(resulttype) list(instr) 'end' opt(ident) { BlockInstr $2 (fromMaybe [] $3) $4 }
-- TODO: check if optional labels are equal if they exist
| 'loop' opt(ident) opt(resulttype) list(instr) 'end' opt(ident) { LoopInstr $2 (fromMaybe [] $3) $4 }
-- TODO: check if optional labels are equal if they exist
| 'if' opt(ident) opt(resulttype) list(instr)
'else' opt(ident) list(instr)
'end' opt(ident) { IfInstr $2 (fromMaybe [] $3) $4 $7 }
foldedinstr :: { [Instruction] }
: '(' foldedinst1 { $2 }
foldedinst1 :: { [Instruction] }
: plaininstr list(foldedinstr) ')' { concat $2 ++ [PlainInstr $1] }
| 'call_indirect' folded_call_indirect { $2 }
| 'block' opt(ident) folded_block { [$3 $2] }
| 'loop' opt(ident) folded_loop { [$3 $2] }
| 'if' opt(ident) '(' folded_if_result { $4 $2 }
folded_block :: { Maybe Ident -> Instruction }
: ')' { \ident -> BlockInstr ident [] [] }
| '(' folded_block1 { $2 }
folded_block1 :: { Maybe Ident -> Instruction }
: 'result' valtype ')' list(foldedinstr) ')' { \ident -> BlockInstr ident [$2] (concat $4) }
| foldedinst1 list(foldedinstr) ')' { \ident -> BlockInstr ident [] ($1 ++ concat $2) }
folded_loop :: { Maybe Ident -> Instruction }
: ')' { \ident -> LoopInstr ident [] [] }
| '(' folded_loop1 { $2 }
folded_loop1 :: { Maybe Ident -> Instruction }
: 'result' valtype ')' list(foldedinstr) ')' { \ident -> LoopInstr ident [$2] (concat $4) }
| foldedinst1 list(foldedinstr) ')' { \ident -> LoopInstr ident [] ($1 ++ concat $2) }
folded_if_result :: { Maybe Ident -> [Instruction] }
: 'result' valtype ')' '(' folded_then_else { \ident -> [IfInstr ident [$2] (fst $5) (snd $5)] }
| 'result' valtype ')' '(' foldedinst1 '(' folded_then_else { \ident -> $5 ++ [IfInstr ident [$2] (fst $7) (snd $7)] }
| folded_if { $1 }
folded_if :: { Maybe Ident -> [Instruction] }
: folded_then_else { \ident -> [IfInstr ident [] (fst $1) (snd $1)] }
| foldedinst1 '(' folded_then_else { \ident -> $1 ++ [IfInstr ident [] (fst $3) (snd $3)] }
folded_then_else :: { ([Instruction], [Instruction]) }
: 'then' list(foldedinstr) ')' folded_else { (concat $2, $4)}
folded_else :: { [Instruction] }
: ')' { [] }
| '(' 'else' list(foldedinstr) ')' ')' { concat $3 }
folded_call_indirect :: { [Instruction] }
: ')' { [PlainInstr $ CallIndirect $ AnonimousTypeUse $ FuncType [] []] }
| '(' folded_call_indirect_typeuse { (PlainInstr $ CallIndirect $ fst $2) : snd $2 }
folded_call_indirect_typeuse :: { (TypeUse, [Instruction]) }
: 'type' typeidx ')' folded_call_indirect_functype {
(IndexedTypeUse $2 $ fst $4, snd $4)
}
| folded_call_indirect_functype1 {
(AnonimousTypeUse $ fromMaybe (FuncType [] []) $ fst $1, snd $1)
}
folded_call_indirect_functype :: { (Maybe FuncType, [Instruction]) }
: '(' folded_call_indirect_functype1 { $2 }
| ')' { (Nothing, []) }
folded_call_indirect_functype1 :: { (Maybe FuncType, [Instruction]) }
: paramsresulttypeuse folded_call_indirect_functype {
(Just $ mergeFuncType $1 $ fromMaybe emptyFuncType $ fst $2, snd $2)
}
| foldedinst1 list(foldedinstr) ')' { (Nothing, $1 ++ concat $2) }
importdesc :: { ImportDesc }
: 'func' opt(ident) typeuse ')' { ImportFunc $2 $3 }
| 'table' opt(ident) tabletype ')' { ImportTable $2 $3 }
| 'memory' opt(ident) limits ')' { ImportMemory $2 $3 }
| 'global' opt(ident) globaltype ')' { ImportGlobal $2 $3 }
import :: { Import }
: 'import' name name '(' importdesc ')' { Import $2 $3 $5 }
localtypes :: { [LocalType] }
: list(localtype) { concat $1 }
localtype :: { [LocalType] }
: '(' 'local' ident valtype ')' { [LocalType (Just $3) $4] }
| '(' 'local' list(valtype) ')' { map (LocalType Nothing) $3 }
-- FUNCTION --
function :: { [ModuleField] }
: 'func' opt(ident) export_import_typeuse_locals_body { map (appendIdent $2) $3 }
export_import_typeuse_locals_body :: { [ModuleField] }
: ')' { [MFFunc $ Function Nothing (AnonimousTypeUse $ FuncType [] []) [] []] }
| '(' export_import_typeuse_locals_body1 { $2 }
export_import_typeuse_locals_body1 :: { [ModuleField] }
: 'export' name ')' export_import_typeuse_locals_body { (MFExport $ Export $2 $ ExportFunc Nothing) : $4 }
| import_typeuse_locals_body1 { [$1] }
import_typeuse_locals_body :: { ModuleField }
: '(' import_typeuse_locals_body1 { $2 }
| ')' { MFFunc $ Function Nothing (AnonimousTypeUse $ FuncType [] []) [] [] }
import_typeuse_locals_body1 :: { ModuleField }
: 'import' name name ')' typeuse ')' { MFImport $ Import $2 $3 $ ImportFunc Nothing $5 }
| typeuse_locals_body1 { MFFunc $ Function Nothing (t3fst $1) (t3snd $1) (t3thd $1) }
typeuse_locals_body :: { (TypeUse, [LocalType], [Instruction]) }
: '(' typeuse_locals_body1 { $2 }
| ')' { (AnonimousTypeUse $ FuncType [] [], [], []) }
typeuse_locals_body1 :: { (TypeUse, [LocalType], [Instruction]) }
: 'type' typeidx ')' signature_locals_body { (IndexedTypeUse $2 (t3fst $4), t3snd $4, t3thd $4) }
| signature_locals_body1 { (AnonimousTypeUse (fromMaybe emptyFuncType $ t3fst $1), t3snd $1, t3thd $1) }
signature_locals_body :: { (Maybe FuncType, [LocalType], [Instruction]) }
: ')' { (Nothing, [], []) }
| '(' signature_locals_body1 { $2 }
signature_locals_body1 :: { (Maybe FuncType, [LocalType], [Instruction]) }
: 'param' list(valtype) ')' signature_locals_body
{ (Just $ prependFuncParams (map (ParamType Nothing) $2) $ fromMaybe emptyFuncType $ t3fst $4, t3snd $4, t3thd $4) }
| 'param' ident valtype ')' signature_locals_body
{ (Just $ prependFuncParams [ParamType (Just $2) $3] $ fromMaybe emptyFuncType $ t3fst $5, t3snd $5, t3thd $5) }
| 'result' list(valtype) ')' signature_locals_body
{ (Just $ prependFuncResults $2 $ fromMaybe emptyFuncType $ t3fst $4, t3snd $4, t3thd $4) }
| locals_body1 { (Nothing, fst $1, snd $1) }
locals_body :: { ([LocalType], [Instruction]) }
: ')' { ([], []) }
| '(' locals_body1 { $2 }
locals_body1 :: { ([LocalType], [Instruction]) }
: 'local' list(valtype) ')' locals_body { (map (LocalType Nothing) $2 ++ fst $4, snd $4) }
| 'local' ident valtype ')' locals_body { (LocalType (Just $2) $3 : fst $5, snd $5) }
| foldedinst1 list(foldedinstr) ')' { ([], $1 ++ concat $2) }
-- FUNCTION END --
global :: { Global }
: 'global' opt(ident) globaltype list(foldedinstr) ')' { Global $2 $3 (concat $4) }
memory :: { Memory }
: 'memory' opt(ident) limits ')' { Memory $2 $3 }
-- TABLE --
limits :: { Limit }
: u32 opt(u32) { Limit (fromIntegral $1) (fromIntegral `fmap` $2) }
elemtype :: { ElemType }
: 'anyfunc' { AnyFunc }
tabletype :: { TableType }
: limits elemtype { TableType $1 $2 }
table :: { [ModuleField] }
: 'table' opt(ident) limits_elemtype_elem { map (appendIdent $2) $3 }
limits_elemtype_elem :: { [ModuleField] }
: tabletype ')' { [MFTable $ Table Nothing $1] }
| elemtype '(' 'elem' list(funcidx) ')' ')' {
let funcsLen = fromIntegral $ length $4 in [
MFTable $ Table Nothing $ TableType (Limit funcsLen (Just funcsLen)) $1,
MFElem $ ElemSegment (Index 0) [PlainInstr $ I32Const 0] $4
]
}
| '(' import_export_table { $2 }
import_export_table :: { [ModuleField] }
: 'import' name name ')' tabletype ')' { [MFImport $ Import $2 $3 $ ImportTable Nothing $5] }
| 'export' name ')' limits_elemtype_elem { (MFExport $ Export $2 $ ExportTable Nothing) : $4 }
-- TABLE END --
exportdesc :: { ExportDesc }
: 'func' funcidx ')' { ExportFunc (Just $2) }
| 'table' tableidx ')' { ExportTable (Just $2) }
| 'memory' memidx ')' { ExportMemory $2 }
| 'global' globalidx ')' { ExportGlobal $2 }
export :: { Export }
: 'export' name '(' exportdesc ')' { Export $2 $4 }
start :: { StartFunction }
: 'start' funcidx ')' { 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' foldedinstr ')' { $3 }
| foldedinstr { $1 }
elemsegment :: { ElemSegment }
: 'elem' opt(tableidx) offsetexpr list(funcidx) ')' { ElemSegment (fromMaybe (Index 0) $2) $3 $4 }
datasegment :: { DataSegment }
: 'data' opt(memidx) offsetexpr list(string) ')' { DataSegment (fromMaybe (Index 0) $2) $3 (TL.concat $4) }
modulefield1_single :: { ModuleField }
: typedef { MFType $1 }
| import { MFImport $1 }
| memory { MFMem $1 }
| global { MFGlobal $1 }
| export { MFExport $1 }
| start { MFStart $1 }
| elemsegment { MFElem $1 }
| datasegment { MFData $1 }
modulefield1_multi :: { [ModuleField] }
: function { $1 }
| table { $1 }
modulefield1 :: { [ModuleField] }
: modulefield1_single { [$1] }
| modulefield1_multi { $1 }
modulefield :: { [ModuleField] }
: '(' modulefield1 { $2 }
modulefields :: { Module }
: modulefields modulefield { foldl' (flip appendModuleField) $1 $2 }
| {- empty -} { emptyModule }
mod :: { Module }
: '(' 'module' modulefields ')' EOF { reverseModuleFields $3 }
| modulefields EOF { reverseModuleFields $1 }
-- utils
rev_list(p)
: rev_list(p) p { $2 : $1 }
| {- empty -} { [] }
rev_list1(p)
: rev_list1(p) p { $2 : $1 }
| p { [$1] }
list(p)
: rev_list(p) { reverse $1 }
list1(p)
: rev_list1(p) { reverse $1 }
opt(p)
: p { Just $1 }
| { Nothing }
{
t3fst :: (a, b, c) -> a
t3fst (a, _, _) = a
t3snd :: (a, b, c) -> b
t3snd (_, a, _) = a
t3thd :: (a, b, c) -> c
t3thd (_, _, a) = a
appendIdent :: Maybe Ident -> ModuleField -> ModuleField
appendIdent i (MFFunc fun) = MFFunc $ fun { ident = i }
appendIdent i (MFImport (Import sm name (ImportFunc _ typeUse))) = MFImport $ Import sm name $ ImportFunc i typeUse
appendIdent i (MFImport (Import sm name (ImportTable _ elemType))) = MFImport $ Import sm name $ ImportTable i elemType
appendIdent i (MFExport (Export name (ExportFunc _))) = MFExport $ Export name $ ExportFunc $ Named <$> i
appendIdent i (MFExport (Export name (ExportTable _))) = MFExport $ Export name $ ExportTable $ Named <$> i
appendIdent i (MFTable (Table _ tableType)) = MFTable $ Table i tableType
appendIdent (Just id) (MFElem segm) = MFElem $ segm { tableIndex = Named id }
appendIdent _ mf = mf
prependFuncParams :: [ParamType] -> FuncType -> FuncType
prependFuncParams prep (FuncType params results) = FuncType (prep ++ params) results
prependFuncResults :: [ValueType] -> FuncType -> FuncType
prependFuncResults prep (FuncType params results) = FuncType params (prep ++ results)
mergeFuncType :: FuncType -> FuncType -> FuncType
mergeFuncType (FuncType lps lrs) (FuncType rps rrs) = FuncType (lps ++ rps) (lrs ++ rrs)
asUInt32 :: Integer -> Maybe Natural
asUInt32 val
| val >= 0, val < 2 ^ 32 = Just $ fromIntegral val
| otherwise = Nothing
asInt32 :: Integer -> Maybe Integer
asInt32 val
| val >= -2 ^ 31, val < 2 ^ 32 = Just $ fromIntegral val
| otherwise = Nothing
asInt64 :: Integer -> Maybe Integer
asInt64 val
| val >= -2 ^ 63, val < 2 ^ 64 = Just $ fromIntegral val
| otherwise = Nothing
asFloat32 :: Double -> Float
asFloat32 = realToFrac
asFloat64 :: Double -> Double
asFloat64 = id
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)
-- TODO: check name conditions.
-- Presuming the source text is itself encoded correctly,
-- strings that do not contain any uses of hexadecimal byte escapes are always valid names.
asName :: LBS.ByteString -> Maybe TL.Text
asName = Just . TLEncoding.decodeUtf8
asString :: LBS.ByteString -> Maybe TL.Text
asString = Just . TLEncoding.decodeUtf8
eitherToMaybe :: Either left right -> Maybe right
eitherToMaybe = either (const Nothing) Just
data ValueType =
I32
| I64
| F32
| F64
deriving (Show, Eq)
data FuncType = FuncType {
params :: [ParamType],
results :: [ValueType]
} deriving (Show, Eq)
emptyFuncType :: FuncType
emptyFuncType = FuncType [] []
data ParamType = ParamType {
ident :: Maybe Ident,
paramType :: ValueType
} deriving (Show, Eq)
newtype Ident = Ident T.Text deriving (Show, Eq)
data GlobalType = Const ValueType | Mut ValueType deriving (Show, Eq)
data Limit = Limit Natural (Maybe Natural) deriving (Show, Eq)
data ElemType = AnyFunc deriving (Show, Eq)
data TableType = TableType Limit ElemType deriving (Show, Eq)
data Index = Named Ident | Index Natural deriving (Show, Eq)
type LabelIndex = Index
type FuncIndex = Index
type TypeIndex = Index
type LocalIndex = Index
type GlobalIndex = Index
type TableIndex = Index
type MemoryIndex = Index
data PlainInstr =
-- Control instructions
Unreachable
| Nop
| Br LabelIndex
| BrIf LabelIndex
| BrTable [LabelIndex] LabelIndex
| 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
| I32Store8 MemArg
| I32Store16 MemArg
| I64Store8 MemArg
| I64Store16 MemArg
| I64Store32 MemArg
| CurrentMemory
| GrowMemory
-- Numeric instructions
| I32Const Integer
| I64Const Integer
| F32Const Float
| F64Const Double
| I32Clz
| I32Ctz
| I32Popcnt
| I32Add
| I32Sub
| I32Mul
| I32DivS
| I32DivU
| I32RemS
| I32RemU
| I32And
| I32Or
| I32Xor
| I32Shl
| I32ShrS
| I32ShrU
| I32Rotl
| I32Rotr
| I64Clz
| I64Ctz
| I64Popcnt
| I64Add
| I64Sub
| I64Mul
| I64DivS
| I64DivU
| I64RemS
| I64RemU
| I64And
| I64Or
| I64Xor
| I64Shl
| I64ShrS
| I64ShrU
| I64Rotl
| I64Rotr
| F32Abs
| F32Neg
| F32Ceil
| F32Floor
| F32Trunc
| F32Nearest
| F32Sqrt
| F32Add
| F32Sub
| F32Mul
| F32Div
| F32Min
| F32Max
| F32Copysign
| F64Abs
| F64Neg
| F64Ceil
| F64Floor
| F64Trunc
| F64Nearest
| F64Sqrt
| F64Add
| F64Sub
| F64Mul
| F64Div
| F64Min
| F64Max
| F64Copysign
| I32Eqz
| I32Eq
| I32Ne
| I32LtS
| I32LtU
| I32GtS
| I32GtU
| I32LeS
| I32LeU
| I32GeS
| I32GeU
| I64Eqz
| I64Eq
| I64Ne
| I64LtS
| I64LtU
| I64GtS
| I64GtU
| I64LeS
| I64LeU
| I64GeS
| I64GeU
| F32Eq
| F32Ne
| F32Lt
| F32Gt
| F32Le
| F32Ge
| F64Eq
| F64Ne
| F64Lt
| F64Gt
| F64Le
| F64Ge
| I32WrapI64
| I32TruncSF32
| I32TruncUF32
| I32TruncSF64
| I32TruncUF64
| I64ExtendSI32
| I64ExtendUI32
| I64TruncSF32
| I64TruncUF32
| I64TruncSF64
| I64TruncUF64
| F32ConvertSI32
| F32ConvertUI32
| F32ConvertSI64
| F32ConvertUI64
| F32DemoteF64
| F64ConvertSI32
| F64ConvertUI32
| F64ConvertSI64
| F64ConvertUI64
| F64PromoteF32
| I32ReinterpretF32
| I64ReinterpretF64
| F32ReinterpretI32
| F64ReinterpretI64
deriving (Show, Eq)
data TypeDef = TypeDef (Maybe Ident) FuncType deriving (Show, Eq)
data TypeUse =
IndexedTypeUse TypeIndex (Maybe FuncType)
| AnonimousTypeUse FuncType
deriving (Show, Eq)
data MemArg = MemArg { offset :: Natural, align :: Natural } deriving (Show, Eq)
data Instruction =
PlainInstr PlainInstr
| BlockInstr {
label :: Maybe Ident,
resultType :: [ValueType],
body :: [Instruction]
}
| LoopInstr {
label :: Maybe Ident,
resultType :: [ValueType],
body :: [Instruction]
}
| IfInstr {
label :: Maybe Ident,
resultType :: [ValueType],
trueBranch :: [Instruction],
falseBranch :: [Instruction]
}
deriving (Show, Eq)
data Import = Import {
sourceModule :: TL.Text,
name :: TL.Text,
desc :: ImportDesc
} deriving (Show, Eq)
data ImportDesc =
ImportFunc (Maybe Ident) TypeUse
| ImportTable (Maybe Ident) TableType
| ImportMemory (Maybe Ident) Limit
| ImportGlobal (Maybe Ident) GlobalType
deriving (Show, Eq)
data LocalType = LocalType {
ident :: Maybe Ident,
localType :: ValueType
} deriving (Show, Eq)
data Function = Function {
ident :: Maybe Ident,
funType :: TypeUse,
locals :: [LocalType],
body :: [Instruction]
}
deriving (Show, Eq)
data Global = Global {
ident :: Maybe Ident,
globalType :: GlobalType,
initializer :: [Instruction]
}
deriving (Show, Eq)
data Memory = Memory (Maybe Ident) Limit deriving (Show, Eq)
data Table = Table (Maybe Ident) TableType deriving (Show, Eq)
data ExportDesc =
ExportFunc (Maybe FuncIndex)
| ExportTable (Maybe TableIndex)
| ExportMemory MemoryIndex
| ExportGlobal GlobalIndex
deriving (Show, Eq)
data Export = Export {
name :: TL.Text,
desc :: ExportDesc
}
deriving (Show, Eq)
data StartFunction = StartFunction FuncIndex deriving (Show, Eq)
data ElemSegment = ElemSegment {
tableIndex :: TableIndex,
offset :: [Instruction],
funcIndexes :: [FuncIndex]
}
deriving (Show, Eq)
data DataSegment = DataSegment {
memIndex :: MemoryIndex,
offset :: [Instruction],
datastring :: TL.Text
}
deriving (Show, Eq)
data ModuleField =
MFType TypeDef
| MFImport Import
| MFFunc Function
| MFTable Table
| MFMem Memory
| MFGlobal Global
| MFExport Export
| MFStart StartFunction
| MFElem ElemSegment
| MFData DataSegment
deriving(Show, Eq)
data Module = Module {
types :: [TypeDef],
imports :: [Import],
functions :: [Function],
tables :: [Table],
memories :: [Memory],
globals :: [Global],
exports :: [Export],
start :: Maybe StartFunction,
elems :: [ElemSegment],
datas :: [DataSegment]
}
deriving (Show, Eq)
emptyModule :: Module
emptyModule =
Module {
types = [],
imports = [],
functions = [],
tables = [],
memories = [],
globals = [],
exports = [],
start = Nothing,
elems = [],
datas = []
}
appendModuleField :: ModuleField -> Module -> Module
appendModuleField field mod =
case field of
MFType typeDef -> mod { types = typeDef : types mod }
MFImport imp -> mod { imports = imp : imports mod }
MFFunc func -> mod { functions = func : functions mod }
MFTable table -> mod { tables = table : tables mod }
MFMem mem -> mod { memories = mem : memories mod }
MFGlobal global -> mod { globals = global : globals mod }
MFExport exp -> mod { exports = exp : exports mod }
MFStart startFunc -> mod { start = Just startFunc }
MFElem elem -> mod { elems = elem : elems mod }
MFData dataSeg -> mod { datas = dataSeg : datas mod }
reverseModuleFields :: Module -> Module
reverseModuleFields mod =
Module {
types = reverse $ types mod,
imports = reverse $ imports mod,
functions = reverse $ functions mod,
tables = reverse $ tables mod,
memories = reverse $ memories mod,
globals = reverse $ globals mod,
exports = reverse $ exports mod,
start = start mod,
elems = reverse $ elems mod,
datas = reverse $ datas mod
}
happyError (Lexeme _ EOF : []) = error $ "Error occuried during parsing phase at the end of file"
happyError (Lexeme (AlexPn abs line col) tok : tokens) = error $
"Error occuried during parsing phase. " ++
"Line " ++ show line ++ ", " ++
"Column " ++ show col ++ ", " ++
"Token " ++ show tok ++ ". " ++
"Token lookahed: " ++ show (take 3 tokens)
}
View Git Blame Copy Permalink