Serde.hs

-- Note: this is an automatically generated file. Do not edit.
-- | WebAssembly serializer: converts WAT AST to concrete WAT text format

module Hydra.Wasm.Serde where
import qualified Hydra.Ast as Ast
import qualified Hydra.Coders as Coders
import qualified Hydra.Constants as Constants
import qualified Hydra.Core as Core
import qualified Hydra.Error.Checking as Checking
import qualified Hydra.Error.Core as ErrorCore
import qualified Hydra.Error.Packaging as ErrorPackaging
import qualified Hydra.Errors as Errors
import qualified Hydra.Graph as Graph
import qualified Hydra.Json.Model as Model
import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality
import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists
import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals
import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic
import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals
import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings
import qualified Hydra.Packaging as Packaging
import qualified Hydra.Parsing as Parsing
import qualified Hydra.Paths as Paths
import qualified Hydra.Query as Query
import qualified Hydra.Relational as Relational
import qualified Hydra.Serialization as Serialization
import qualified Hydra.Tabular as Tabular
import qualified Hydra.Testing as Testing
import qualified Hydra.Topology as Topology
import qualified Hydra.Typed as Typed
import qualified Hydra.Typing as Typing
import qualified Hydra.Util as Util
import qualified Hydra.Validation as Validation
import qualified Hydra.Variants as Variants
import qualified Hydra.Wasm.Syntax as Syntax
import Prelude hiding  (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)
import qualified Data.Scientific as Sci
-- | Serialize a block or loop instruction to WAT
blockInstructionToExpr :: String -> Syntax.BlockInstruction -> Ast.Expr
blockInstructionToExpr keyword b =

      let label = Syntax.blockInstructionLabel b
          bt = Syntax.blockInstructionBlockType b
          body = Syntax.blockInstructionBody b
          labelStr = Optionals.cases label "" (\l -> Strings.cat2 " $" l)
          btPart = blockTypeToExpr bt
          bodyParts = Lists.map instructionToExpr body
          header =
                  Serialization.spaceSep (Optionals.cat [
                    Just (Serialization.cst (Strings.cat [
                      "(",
                      keyword,
                      labelStr])),
                    btPart])
      in (Serialization.newlineSep (Lists.concat [
        [
          header],
        (Lists.map (\p -> Serialization.cst (Strings.cat2 "  " (Serialization.printExpr p))) bodyParts),
        [
          Serialization.cst ")"]]))
-- | Serialize a block type to WAT
blockTypeToExpr :: Syntax.BlockType -> Maybe Ast.Expr
blockTypeToExpr bt =
    case bt of
      Syntax.BlockTypeEmpty -> Nothing
      Syntax.BlockTypeValue v0 -> Just (Serialization.cst (Strings.cat [
        "(result ",
        (valTypeToStr v0),
        ")"]))
      Syntax.BlockTypeTypeUse v0 -> Just (typeUseToExpr v0)
-- | Serialize a constant value instruction to WAT
constValueToExpr :: Syntax.ConstValue -> Ast.Expr
constValueToExpr c =
    case c of
      Syntax.ConstValueI32 v0 -> Serialization.cst (Strings.cat2 "i32.const " (Literals.showInt32 v0))
      Syntax.ConstValueI64 v0 -> Serialization.cst (Strings.cat2 "i64.const " (Literals.showInt64 v0))
      Syntax.ConstValueF32 v0 -> Serialization.cst (Strings.cat2 "f32.const " (Literals.showFloat32 v0))
      Syntax.ConstValueF64 v0 -> Serialization.cst (Strings.cat2 "f64.const " (Literals.showFloat64 v0))
-- | Serialize a data segment to WAT
dataSegmentToExpr :: Syntax.DataSegment -> Ast.Expr
dataSegmentToExpr d =

      let name = Syntax.dataSegmentName d
          mode = Syntax.dataSegmentMode d
          bytes = Syntax.dataSegmentBytes d
          nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
      in case mode of
        Syntax.DataModeActive v0 -> Serialization.spaceSep [
          Serialization.cst (Strings.cat2 "(data" nameStr),
          (Serialization.spaceSep [
            Serialization.cst "(offset",
            (Serialization.spaceSep (Lists.map instructionToExpr v0)),
            (Serialization.cst ")")]),
          (Serialization.cst (Strings.cat [
            "\"",
            bytes,
            "\")"]))]
        Syntax.DataModePassive -> Serialization.spaceSep [
          Serialization.cst (Strings.cat2 "(data" nameStr),
          (Serialization.cst (Strings.cat [
            "\"",
            bytes,
            "\")"]))]
-- | Serialize an export declaration to WAT
exportDefToExpr :: Syntax.ExportDef -> Ast.Expr
exportDefToExpr e =

      let name = Syntax.exportDefName e
          desc = Syntax.exportDefDesc e
      in (Serialization.spaceSep [
        Serialization.cst "(export",
        (Serialization.cst (Strings.cat [
          "\"",
          name,
          "\""])),
        (exportDescToExpr desc),
        (Serialization.cst ")")])
-- | Serialize an export descriptor to WAT
exportDescToExpr :: Syntax.ExportDesc -> Ast.Expr
exportDescToExpr desc =
    case desc of
      Syntax.ExportDescFunc v0 -> Serialization.cst (Strings.cat [
        "(func $",
        v0,
        ")"])
      Syntax.ExportDescMemory v0 -> Serialization.cst (Strings.cat [
        "(memory $",
        v0,
        ")"])
      Syntax.ExportDescTable v0 -> Serialization.cst (Strings.cat [
        "(table $",
        v0,
        ")"])
      Syntax.ExportDescGlobal v0 -> Serialization.cst (Strings.cat [
        "(global $",
        v0,
        ")"])
-- | Serialize a local variable declaration to WAT
funcLocalToExpr :: Syntax.FuncLocal -> Ast.Expr
funcLocalToExpr l =

      let name = Syntax.funcLocalName l
          typ = Syntax.funcLocalType l
          nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
      in (Serialization.cst (Strings.cat [
        "(local",
        nameStr,
        " ",
        (valTypeToStr typ),
        ")"]))
-- | Serialize a function definition to WAT
funcToExpr :: Syntax.Func -> Ast.Expr
funcToExpr f =

      let name = Syntax.funcName f
          typeUse = Syntax.funcTypeUse f
          locals = Syntax.funcLocals f
          body = Syntax.funcBody f
          nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
          headerStr = Strings.cat2 "(func" nameStr
          typeUsePart = typeUseToExpr typeUse
          localParts = Lists.map funcLocalToExpr locals
          bodyParts = Lists.map instructionToExpr body
          innerParts = Lists.concat2 localParts bodyParts
      in (Logic.ifElse (Lists.null innerParts) (Serialization.spaceSep [
        Serialization.cst headerStr,
        typeUsePart,
        (Serialization.cst ")")]) (Serialization.newlineSep (Lists.concat [
        [
          Serialization.spaceSep [
            Serialization.cst headerStr,
            typeUsePart]],
        (Lists.map (\p -> Serialization.cst (Strings.cat2 "  " (Serialization.printExpr p))) innerParts),
        [
          Serialization.cst ")"]])))
-- | Serialize a function type to WAT
funcTypeToExpr :: Syntax.FuncType -> Ast.Expr
funcTypeToExpr ft =

      let params = Syntax.funcTypeParams ft
          results = Syntax.funcTypeResults ft
          paramParts =
                  Lists.map (\p -> Serialization.cst (Strings.cat [
                    "(param ",
                    (valTypeToStr p),
                    ")"])) params
          resultParts =
                  Lists.map (\r -> Serialization.cst (Strings.cat [
                    "(result ",
                    (valTypeToStr r),
                    ")"])) results
      in (Serialization.spaceSep (Optionals.cat [
        Just (Serialization.cst "(func"),
        (Logic.ifElse (Lists.null paramParts) Nothing (Just (Serialization.spaceSep paramParts))),
        (Logic.ifElse (Lists.null resultParts) Nothing (Just (Serialization.spaceSep resultParts))),
        (Just (Serialization.cst ")"))]))
-- | Serialize a global definition to WAT
globalDefToExpr :: Syntax.GlobalDef -> Ast.Expr
globalDefToExpr g =

      let name = Syntax.globalDefName g
          gt = Syntax.globalDefType g
          init = Syntax.globalDefInit g
          nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
      in (Serialization.spaceSep [
        Serialization.cst (Strings.cat2 "(global" nameStr),
        (globalTypeToExpr gt),
        (Serialization.spaceSep (Lists.map instructionToExpr init)),
        (Serialization.cst ")")])
-- | Serialize a global type to WAT
globalTypeToExpr :: Syntax.GlobalType -> Ast.Expr
globalTypeToExpr gt =

      let vt = Syntax.globalTypeValType gt
          mut = Syntax.globalTypeMutable gt
      in (Logic.ifElse mut (Serialization.cst (Strings.cat [
        "(mut ",
        (valTypeToStr vt),
        ")"])) (Serialization.cst (valTypeToStr vt)))
-- | Serialize an if instruction to WAT
ifInstructionToExpr :: Syntax.IfInstruction -> Ast.Expr
ifInstructionToExpr i =

      let label = Syntax.ifInstructionLabel i
          bt = Syntax.ifInstructionBlockType i
          thenBranch = Syntax.ifInstructionThen i
          elseBranch = Syntax.ifInstructionElse i
          labelStr = Optionals.cases label "" (\l -> Strings.cat2 " $" l)
          btPart = blockTypeToExpr bt
          thenParts = Lists.map instructionToExpr thenBranch
          elseParts = Lists.map instructionToExpr elseBranch
          header =
                  Serialization.spaceSep (Optionals.cat [
                    Just (Serialization.cst (Strings.cat [
                      "(if",
                      labelStr])),
                    btPart])
          thenBlock =
                  Serialization.newlineSep (Lists.concat [
                    [
                      Serialization.cst "(then"],
                    (Lists.map (\p -> Serialization.cst (Strings.cat2 "  " (Serialization.printExpr p))) thenParts),
                    [
                      Serialization.cst ")"]])
          elseBlock =
                  Serialization.newlineSep (Lists.concat [
                    [
                      Serialization.cst "(else"],
                    (Lists.map (\p -> Serialization.cst (Strings.cat2 "  " (Serialization.printExpr p))) elseParts),
                    [
                      Serialization.cst ")"]])
      in (Logic.ifElse (Lists.null elseParts) (Serialization.newlineSep [
        header,
        thenBlock,
        (Serialization.cst ")")]) (Serialization.newlineSep [
        header,
        thenBlock,
        elseBlock,
        (Serialization.cst ")")]))
-- | Serialize an import declaration to WAT
importDefToExpr :: Syntax.ImportDef -> Ast.Expr
importDefToExpr i =

      let modName = Syntax.importDefModule i
          name = Syntax.importDefName i
          desc = Syntax.importDefDesc i
      in (Serialization.spaceSep [
        Serialization.cst "(import",
        (Serialization.cst (Strings.cat [
          "\"",
          modName,
          "\""])),
        (Serialization.cst (Strings.cat [
          "\"",
          name,
          "\""])),
        (importDescToExpr desc),
        (Serialization.cst ")")])
-- | Serialize an import descriptor to WAT
importDescToExpr :: Syntax.ImportDesc -> Ast.Expr
importDescToExpr desc =
    case desc of
      Syntax.ImportDescFunc v0 ->
        let name = Syntax.importFuncName v0
            tu = Syntax.importFuncTypeUse v0
            nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
        in (Serialization.spaceSep [
          Serialization.cst (Strings.cat2 "(func" nameStr),
          (typeUseToExpr tu),
          (Serialization.cst ")")])
      Syntax.ImportDescMemory v0 ->
        let name = Syntax.importMemoryName v0
            lim = Syntax.importMemoryLimits v0
            nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
        in (Serialization.spaceSep [
          Serialization.cst (Strings.cat2 "(memory" nameStr),
          (limitsToExpr lim),
          (Serialization.cst ")")])
      Syntax.ImportDescTable v0 ->
        let name = Syntax.importTableName v0
            rt = Syntax.importTableRefType v0
            lim = Syntax.importTableLimits v0
            nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
        in (Serialization.spaceSep [
          Serialization.cst (Strings.cat2 "(table" nameStr),
          (limitsToExpr lim),
          (Serialization.cst (refTypeToStr rt)),
          (Serialization.cst ")")])
      Syntax.ImportDescGlobal v0 ->
        let name = Syntax.importGlobalName v0
            gt = Syntax.importGlobalType v0
            nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
        in (Serialization.spaceSep [
          Serialization.cst (Strings.cat2 "(global" nameStr),
          (globalTypeToExpr gt),
          (Serialization.cst ")")])
-- | Serialize an instruction to WAT
instructionToExpr :: Syntax.Instruction -> Ast.Expr
instructionToExpr instr =
    case instr of
      Syntax.InstructionConst v0 -> constValueToExpr v0
      Syntax.InstructionLocalGet v0 -> Serialization.cst (Strings.cat [
        "local.get $",
        v0])
      Syntax.InstructionLocalSet v0 -> Serialization.cst (Strings.cat [
        "local.set $",
        v0])
      Syntax.InstructionLocalTee v0 -> Serialization.cst (Strings.cat [
        "local.tee $",
        v0])
      Syntax.InstructionGlobalGet v0 -> Serialization.cst (Strings.cat [
        "global.get $",
        v0])
      Syntax.InstructionGlobalSet v0 -> Serialization.cst (Strings.cat [
        "global.set $",
        v0])
      Syntax.InstructionLoad v0 ->
        let vt = Syntax.memoryInstructionType v0
            ma = Syntax.memoryInstructionMemArg v0
            off = Syntax.memArgOffset ma
            offStr = Logic.ifElse (Equality.equal off 0) "" (Strings.cat2 " offset=" (Literals.showInt32 off))
        in (Serialization.cst (Strings.cat [
          valTypeToStr vt,
          ".load",
          offStr]))
      Syntax.InstructionStore v0 ->
        let vt = Syntax.memoryInstructionType v0
            ma = Syntax.memoryInstructionMemArg v0
            off = Syntax.memArgOffset ma
            offStr = Logic.ifElse (Equality.equal off 0) "" (Strings.cat2 " offset=" (Literals.showInt32 off))
        in (Serialization.cst (Strings.cat [
          valTypeToStr vt,
          ".store",
          offStr]))
      Syntax.InstructionUnop v0 ->
        let vt = Syntax.numericOpType v0
            nm = Syntax.numericOpName v0
        in (Serialization.cst (Strings.cat [
          valTypeToStr vt,
          ".",
          nm]))
      Syntax.InstructionBinop v0 ->
        let vt = Syntax.numericOpType v0
            nm = Syntax.numericOpName v0
        in (Serialization.cst (Strings.cat [
          valTypeToStr vt,
          ".",
          nm]))
      Syntax.InstructionTestop v0 ->
        let vt = Syntax.numericOpType v0
            nm = Syntax.numericOpName v0
        in (Serialization.cst (Strings.cat [
          valTypeToStr vt,
          ".",
          nm]))
      Syntax.InstructionRelop v0 ->
        let vt = Syntax.numericOpType v0
            nm = Syntax.numericOpName v0
        in (Serialization.cst (Strings.cat [
          valTypeToStr vt,
          ".",
          nm]))
      Syntax.InstructionConvert v0 -> Serialization.cst v0
      Syntax.InstructionCall v0 -> Serialization.cst (Strings.cat [
        "call $",
        v0])
      Syntax.InstructionCallIndirect v0 -> Serialization.spaceSep [
        Serialization.cst "call_indirect",
        (typeUseToExpr v0)]
      Syntax.InstructionBlock v0 -> blockInstructionToExpr "block" v0
      Syntax.InstructionLoop v0 -> blockInstructionToExpr "loop" v0
      Syntax.InstructionIf v0 -> ifInstructionToExpr v0
      Syntax.InstructionBr v0 -> Serialization.cst (Strings.cat [
        "br $",
        v0])
      Syntax.InstructionBrIf v0 -> Serialization.cst (Strings.cat [
        "br_if $",
        v0])
      Syntax.InstructionBrTable v0 ->
        let labels = Syntax.brTableArgsLabels v0
            def = Syntax.brTableArgsDefault v0
        in (Serialization.cst (Strings.cat [
          "br_table ",
          (Strings.intercalate " " (Lists.map (\l -> Strings.cat2 "$" l) labels)),
          " $",
          def]))
      Syntax.InstructionReturn -> Serialization.cst "return"
      Syntax.InstructionDrop -> Serialization.cst "drop"
      Syntax.InstructionSelect -> Serialization.cst "select"
      Syntax.InstructionUnreachable -> Serialization.cst "unreachable"
      Syntax.InstructionNop -> Serialization.cst "nop"
      Syntax.InstructionMemorySize -> Serialization.cst "memory.size"
      Syntax.InstructionMemoryGrow -> Serialization.cst "memory.grow"
      Syntax.InstructionRefNull v0 -> Serialization.cst (Strings.cat [
        "ref.null ",
        (refTypeToStr v0)])
      Syntax.InstructionRefIsNull -> Serialization.cst "ref.is_null"
      Syntax.InstructionRaw v0 -> Serialization.cst v0
-- | Serialize limits to WAT
limitsToExpr :: Syntax.Limits -> Ast.Expr
limitsToExpr l =

      let mn = Syntax.limitsMin l
          mx = Syntax.limitsMax l
      in (Serialization.spaceSep (Optionals.cat [
        Just (Serialization.cst (Literals.showInt32 mn)),
        (Optionals.map (\m -> Serialization.cst (Literals.showInt32 m)) mx)]))
-- | Serialize a memory definition to WAT
memoryDefToExpr :: Syntax.MemoryDef -> Ast.Expr
memoryDefToExpr m =

      let name = Syntax.memoryDefName m
          lim = Syntax.memoryDefLimits m
          nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
      in (Serialization.spaceSep [
        Serialization.cst (Strings.cat2 "(memory" nameStr),
        (limitsToExpr lim),
        (Serialization.cst ")")])
-- | Serialize a module field to a WAT expression
moduleFieldToExpr :: Syntax.ModuleField -> Ast.Expr
moduleFieldToExpr field =
    case field of
      Syntax.ModuleFieldType v0 -> typeDefToExpr v0
      Syntax.ModuleFieldFunc v0 -> funcToExpr v0
      Syntax.ModuleFieldMemory v0 -> memoryDefToExpr v0
      Syntax.ModuleFieldTable v0 -> tableDefToExpr v0
      Syntax.ModuleFieldGlobal v0 -> globalDefToExpr v0
      Syntax.ModuleFieldImport v0 -> importDefToExpr v0
      Syntax.ModuleFieldExport v0 -> exportDefToExpr v0
      Syntax.ModuleFieldData v0 -> dataSegmentToExpr v0
      Syntax.ModuleFieldElem _ -> Serialization.cst ";; elem segment (not yet supported)"
      Syntax.ModuleFieldStart v0 -> Serialization.cst (Strings.cat [
        "(start $",
        v0,
        ")"])
-- | Serialize a WebAssembly module to a WAT expression
moduleToExpr :: Syntax.Module -> Ast.Expr
moduleToExpr mod =

      let name = Syntax.moduleName mod
          fields = Syntax.moduleFields mod
          nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
          fieldExprs = Lists.map moduleFieldToExpr fields
      in (Serialization.newlineSep (Lists.concat [
        [
          Serialization.cst (Strings.cat2 "(module" nameStr)],
        (Lists.map (\fe -> Serialization.cst (Strings.cat2 "  " (Serialization.printExpr fe))) fieldExprs),
        [
          Serialization.cst ")"]]))
-- | Serialize a function parameter to WAT
paramToExpr :: Syntax.Param -> Ast.Expr
paramToExpr p =

      let name = Syntax.paramName p
          typ = Syntax.paramType p
          nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
      in (Serialization.cst (Strings.cat [
        "(param",
        nameStr,
        " ",
        (valTypeToStr typ),
        ")"]))
-- | Convert a reference type to its WAT string
refTypeToStr :: Syntax.RefType -> String
refTypeToStr rt =
    case rt of
      Syntax.RefTypeFuncref -> "funcref"
      Syntax.RefTypeExternref -> "externref"
-- | Serialize a table definition to WAT
tableDefToExpr :: Syntax.TableDef -> Ast.Expr
tableDefToExpr t =

      let name = Syntax.tableDefName t
          rt = Syntax.tableDefRefType t
          lim = Syntax.tableDefLimits t
          nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
      in (Serialization.spaceSep [
        Serialization.cst (Strings.cat2 "(table" nameStr),
        (limitsToExpr lim),
        (Serialization.cst (refTypeToStr rt)),
        (Serialization.cst ")")])
-- | Convert a string to a WAT comment
toWatComment :: String -> String
toWatComment s =
    Strings.cat [
      ";; ",
      s]
-- | Serialize a type definition to WAT
typeDefToExpr :: Syntax.TypeDef -> Ast.Expr
typeDefToExpr td =

      let name = Syntax.typeDefName td
          ft = Syntax.typeDefType td
          nameStr = Optionals.cases name "" (\n -> Strings.cat2 " $" n)
      in (Serialization.spaceSep [
        Serialization.cst (Strings.cat2 "(type" nameStr),
        (funcTypeToExpr ft),
        (Serialization.cst ")")])
-- | Serialize a type use clause to WAT
typeUseToExpr :: Syntax.TypeUse -> Ast.Expr
typeUseToExpr tu =

      let idx = Syntax.typeUseIndex tu
          params = Syntax.typeUseParams tu
          results = Syntax.typeUseResults tu
          idxPart =
                  Optionals.map (\i -> Serialization.cst (Strings.cat [
                    "(type $",
                    i,
                    ")"])) idx
          paramParts = Lists.map paramToExpr params
          resultParts =
                  Lists.map (\r -> Serialization.cst (Strings.cat [
                    "(result ",
                    (valTypeToStr r),
                    ")"])) results
      in (Serialization.spaceSep (Optionals.cat (Lists.concat [
        [
          idxPart],
        (Lists.map (\p -> Just p) paramParts),
        (Lists.map (\r -> Just r) resultParts)])))
-- | Convert a value type to its WAT string representation
valTypeToStr :: Syntax.ValType -> String
valTypeToStr vt =
    case vt of
      Syntax.ValTypeI32 -> "i32"
      Syntax.ValTypeI64 -> "i64"
      Syntax.ValTypeF32 -> "f32"
      Syntax.ValTypeF64 -> "f64"
      Syntax.ValTypeFuncref -> "funcref"
      Syntax.ValTypeExternref -> "externref"