From f97441d6b086363a9f70d02cf188f3a6c3d7007c Mon Sep 17 00:00:00 2001 From: Ilya Rezvov Date: Wed, 14 Feb 2018 20:21:20 -0800 Subject: [PATCH] define types for wasm internal structure and share some parts with text representation types --- src/Language/Wasm/Parser.y | 157 +++------------------ src/Language/Wasm/Structure.hs | 244 +++++++++++++++++++++++++++++++++ wasm.cabal | 1 + 3 files changed, 267 insertions(+), 135 deletions(-) create mode 100644 src/Language/Wasm/Structure.hs diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index d87b38a..e0fdb43 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -5,7 +5,6 @@ module Language.Wasm.Parser ( parseModule, - Module(..), ModuleField(..), DataSegment(..), ElemSegment(..), @@ -20,28 +19,31 @@ module Language.Wasm.Parser ( Import(..), ImportDesc(..), Instruction(..), - MemArg(..), TypeUse(..), TypeDef(..), PlainInstr(..), - IUnOp(..), - IBinOp(..), - IRelOp(..), - FUnOp(..), - FBinOp(..), - FRelOp(..), - BitSize(..), Index(..), - TableType(..), - ElemType(..), - Limit(..), - GlobalType(..), Ident(..), ParamType(..), - FuncType(..), - ValueType(..) + FuncType(..) ) where +import Language.Wasm.Structure ( + MemArg(..), + IUnOp(..), + IBinOp(..), + IRelOp(..), + FUnOp(..), + FBinOp(..), + FRelOp(..), + BitSize(..), + TableType(..), + ElemType(..), + Limit(..), + GlobalType(..), + ValueType(..) + ) + import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLEncoding @@ -73,7 +75,7 @@ import Debug.Trace as Debug } -%name parseModule mod +%name parseModule modAsFields %tokentype { Lexeme } %token @@ -830,16 +832,9 @@ modulefield1 :: { [ModuleField] } modulefield :: { [ModuleField] } : '(' modulefield1 { $2 } -modulefields :: { Module } - : modulefields modulefield { foldl' (flip appendModuleField) $1 $2 } - | {- empty -} { emptyModule } - -mod :: { Module } - : '(' mod1 { $2 } - -mod1 :: { Module } - : 'module' modulefields ')' EOF { reverseModuleFields $2 } - | modulefield1 modulefields EOF { reverseModuleFields $ foldl' (flip appendModuleField) $2 $1 } +modAsFields :: { [ModuleField] } + : '(' 'module' list(modulefield) ')' EOF { concat $3 } + | '(' modulefield1 list(modulefield) EOF { $2 ++ concat $3} -- utils @@ -915,17 +910,7 @@ 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) +data FuncType = FuncType { params :: [ParamType], results :: [ValueType] } deriving (Show, Eq) emptyFuncType :: FuncType emptyFuncType = FuncType [] [] @@ -937,14 +922,6 @@ data ParamType = ParamType { 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 @@ -955,36 +932,6 @@ type GlobalIndex = Index type TableIndex = Index type MemoryIndex = Index -data BitSize = BS32 | BS64 deriving (Show, Eq) - -data IUnOp = IClz |ICtz | IPopcnt deriving (Show, Eq) - -data IBinOp = - IAdd - | ISub - | IMul - | IDivU - | IDivS - | IRemU - | IRemS - | IAnd - | IOr - | IXor - | IShl - | IShrU - | IShrS - | IRotl - | IRotr - deriving (Show, Eq) - -data IRelOp = IEq | INe | ILtU | ILtS | IGtU | IGtS | ILeU | ILeS | IGeU | IGeS deriving (Show, Eq) - -data FUnOp = FAbs | FNeg | FSqrt | FCeil | FFloor | FTrunc | FNearest deriving (Show, Eq) - -data FBinOp = FAdd | FSub | FMul | FDiv | FMin | FMax | FCopySign deriving (Show, Eq) - -data FRelOp = FEq | FNe | FLt | FGt | FLe | FGe deriving (Show, Eq) - data PlainInstr = -- Control instructions Unreachable @@ -1063,8 +1010,6 @@ data TypeUse = | AnonimousTypeUse FuncType deriving (Show, Eq) -data MemArg = MemArg { offset :: Natural, align :: Natural } deriving (Show, Eq) - data Instruction = PlainInstr PlainInstr | BlockInstr { @@ -1173,64 +1118,6 @@ data ModuleField = | 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. " ++ diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs new file mode 100644 index 0000000..2a53ab8 --- /dev/null +++ b/src/Language/Wasm/Structure.hs @@ -0,0 +1,244 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DuplicateRecordFields #-} + +module Language.Wasm.Structure ( + Module(..), + DataSegment(..), + ElemSegment(..), + StartFunction(..), + Export(..), + ExportDesc(..), + Table(..), + Memory(..), + Global(..), + Function(..), + Import(..), + ImportDesc(..), + Instruction(..), + MemArg(..), + IUnOp(..), + IBinOp(..), + IRelOp(..), + FUnOp(..), + FBinOp(..), + FRelOp(..), + BitSize(..), + TableType(..), + ElemType(..), + Limit(..), + GlobalType(..), + FuncType(..), + ValueType(..) +) where + +import Numeric.Natural (Natural) +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text.Lazy as TL + +data BitSize = BS32 | BS64 deriving (Show, Eq) + +data IUnOp = IClz | ICtz | IPopcnt deriving (Show, Eq) + +data IBinOp = + IAdd + | ISub + | IMul + | IDivU + | IDivS + | IRemU + | IRemS + | IAnd + | IOr + | IXor + | IShl + | IShrU + | IShrS + | IRotl + | IRotr + deriving (Show, Eq) + +data IRelOp = IEq | INe | ILtU | ILtS | IGtU | IGtS | ILeU | ILeS | IGeU | IGeS deriving (Show, Eq) + +data FUnOp = FAbs | FNeg | FSqrt | FCeil | FFloor | FTrunc | FNearest deriving (Show, Eq) + +data FBinOp = FAdd | FSub | FMul | FDiv | FMin | FMax | FCopySign deriving (Show, Eq) + +data FRelOp = FEq | FNe | FLt | FGt | FLe | FGe deriving (Show, Eq) + +data MemArg = MemArg { offset :: Natural, align :: Natural } deriving (Show, Eq) + +type LabelIndex = Natural +type FuncIndex = Natural +type TypeIndex = Natural +type LocalIndex = Natural +type GlobalIndex = Natural +type MemoryIndex = Natural +type TableIndex = Natural + +data ValueType = + I32 + | I64 + | F32 + | F64 + deriving (Show, Eq) + +type ResultType = [ValueType] +type ParamsType = [ValueType] +type LocalsType = [ValueType] + +data FuncType = FuncType { params :: ParamsType, results :: ResultType } deriving (Show, Eq) + +data Instruction = + -- Control instructions + Unreachable + | Nop + | Block { result :: ResultType, body :: Expression } + | Loop { result :: ResultType, body :: Expression } + | If { result :: ResultType, true :: Expression, false :: Expression } + | Br LabelIndex + | BrIf LabelIndex + | BrTable [LabelIndex] LabelIndex + | Return + | Call FuncIndex + | CallIndirect TypeIndex + -- 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 + | IUnOp BitSize IUnOp + | IBinOp BitSize IBinOp + | I32Eqz + | I64Eqz + | IRelOp BitSize IRelOp + | FUnOp BitSize FUnOp + | FBinOp BitSize FBinOp + | FRelOp BitSize FRelOp + | I32WrapI64 + | ITruncFU {- Int Size -} BitSize {- Float Size -} BitSize + | ITruncFS {- Int Size -} BitSize {- Float Size -} BitSize + | I64ExtendSI32 + | I64ExtendUI32 + | FConvertIU {- Float Size -} BitSize {- Int Size -} BitSize + | FConvertIS {- Float Size -} BitSize {- Int Size -} BitSize + | F32DemoteF64 + | F64PromoteF32 + | IReinterpretF BitSize + | FReinterpretI BitSize + deriving (Show, Eq) + +type Expression = [Instruction] + +data Function = Function { + funcType :: TypeIndex, + locals :: LocalsType, + body :: Expression +} 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 Table = Table TableType deriving (Show, Eq) + +data Memory = Memory Limit deriving (Show, Eq) + +data GlobalType = Const ValueType | Mut ValueType deriving (Show, Eq) + +data Global = Global { + globalType :: GlobalType, + initializer :: Expression + } + deriving (Show, Eq) + +data ElemSegment = ElemSegment { + tableIndex :: TableIndex, + offset :: [Instruction], + funcIndexes :: [FuncIndex] + } + deriving (Show, Eq) + +data DataSegment = DataSegment { + memIndex :: MemoryIndex, + offset :: Expression, + initializer :: LBS.ByteString + } + deriving (Show, Eq) + +data StartFunction = StartFunction FuncIndex deriving (Show, Eq) + +data ExportDesc = + ExportFunc FuncIndex + | ExportTable TableIndex + | ExportMemory MemoryIndex + | ExportGlobal GlobalIndex + deriving (Show, Eq) + +data Export = Export { + name :: TL.Text, + desc :: ExportDesc + } + deriving (Show, Eq) + +data ImportDesc = + ImportFunc TypeIndex + | ImportTable TableType + | ImportMemory Limit + | ImportGlobal GlobalType + deriving (Show, Eq) + +data Import = Import { + sourceModule :: TL.Text, + name :: TL.Text, + desc :: ImportDesc + } deriving (Show, Eq) + +data Module = Module { + types :: [FuncType], + functions :: [Function], + tables :: [Table], + mems :: [Memory], + globals :: [Global], + elems :: [ElemSegment], + datas :: [DataSegment], + start :: Maybe StartFunction, + imports :: [Import], + exports :: [Export] + } deriving (Show, Eq) diff --git a/wasm.cabal b/wasm.cabal index 8137466..6073dde 100644 --- a/wasm.cabal +++ b/wasm.cabal @@ -35,6 +35,7 @@ library exposed-modules: Language.Wasm.Lexer Language.Wasm.Parser + Language.Wasm.Structure Language.Wasm other-modules: Paths_wasm