futhark-manifest (empty) → 1.0.0.0
raw patch · 5 files changed
+339/−0 lines, 5 filesdep +QuickCheckdep +aesondep +base
Dependencies added: QuickCheck, aeson, base, bytestring, containers, futhark-manifest, quickcheck-instances, tasty, tasty-hunit, tasty-quickcheck, text
Files
- CHANGELOG.md +5/−0
- LICENSE +17/−0
- futhark-manifest.cabal +48/−0
- src/Futhark/Manifest.hs +216/−0
- tests/Tests.hs +53/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for futhark-manifest++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,17 @@+ISC License++Copyright (c) 2020-2021. DIKU, University of Copenhagen++Permission to use, copy, modify, and/or distribute this software for+any purpose with or without fee is hereby granted, provided that the+above copyright notice and this permission notice appear in all+copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL+WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE+AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL+DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR+PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR+PERFORMANCE OF THIS SOFTWARE.
+ futhark-manifest.cabal view
@@ -0,0 +1,48 @@+cabal-version: 2.4+name: futhark-manifest+version: 1.0.0.0++synopsis: Definition and serialisation instances for Futhark manifests.++description: The Futhark compiler generates JSON manifest files that describe the C API of a compiled program. This package provides definitions for reading and writing such files.++bug-reports: https://github.com/diku-dk/futhark-manifest-haskell/issues++license: ISC+license-file: LICENSE+author: Troels Henriksen+maintainer: athas@sigkill.dk++category: Futhark+extra-source-files: CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/diku-dk/futhark-manifest-haskell++library+ exposed-modules: Futhark.Manifest++ build-depends: base >=4.14.3.0,+ aeson >=2.0.0.0,+ bytestring >=0.10.8,+ containers >=0.6.2.1,+ text >=1.2.2.2+ hs-source-dirs: src+ ghc-options: -Wall -Wcompat -Wredundant-constraints -Wincomplete-record-updates -Wmissing-export-lists+ default-language: Haskell2010++test-suite futhark-data-test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ hs-source-dirs: tests+ ghc-options: -Wall -Wcompat -Wredundant-constraints -Wincomplete-record-updates -Wmissing-export-lists+ build-depends: base >=4 && < 5+ , futhark-manifest+ , QuickCheck >=2.8+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , text >=1.2.2.2+ , quickcheck-instances >=0.3.27
+ src/Futhark/Manifest.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | C manifest data structure and serialisation to JSON.+--+-- A manifest contains machine-readable information about the API of+-- the compiled Futhark program. Specifically which entry points are+-- available, which types are exposed, and what their C names are.+module Futhark.Manifest+ ( Manifest (..),+ Input (..),+ Output (..),+ EntryPoint (..),+ Type (..),+ ArrayOps (..),+ OpaqueOps (..),+ manifestToJSON,+ manifestFromJSON,+ )+where++import Control.Applicative+import Control.Monad (guard)+import Data.Aeson (ToJSON (..), object, (.!=), (.:), (.:?))+import qualified Data.Aeson as JSON+import qualified Data.Aeson.Key as JSON+import Data.Aeson.Text (encodeToLazyText)+import Data.Bifunctor (bimap)+import Data.ByteString.Builder (toLazyByteString)+import qualified Data.Map as M+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8Builder)+import Data.Text.Lazy (toStrict)++-- | Manifest info for an entry point parameter.+data Input = Input+ { inputName :: T.Text,+ inputType :: T.Text,+ inputUnique :: Bool+ }+ deriving (Eq, Ord, Show)++-- | Manifest info for an entry point return value.+data Output = Output+ { outputType :: T.Text,+ outputUnique :: Bool+ }+ deriving (Eq, Ord, Show)++-- | Manifest info for an entry point.+data EntryPoint = EntryPoint+ { entryPointCFun :: T.Text,+ entryPointOutputs :: [Output],+ entryPointInputs :: [Input]+ }+ deriving (Eq, Ord, Show)++-- | The names of the C functions implementing the operations on some+-- array type.+data ArrayOps = ArrayOps+ { arrayFree :: T.Text,+ arrayShape :: T.Text,+ arrayValues :: T.Text,+ arrayNew :: T.Text+ }+ deriving (Eq, Ord, Show)++-- | The names of the C functions implementing the operations on some+-- opaque type.+data OpaqueOps = OpaqueOps+ { opaqueFree :: T.Text,+ opaqueStore :: T.Text,+ opaqueRestore :: T.Text+ }+ deriving (Eq, Ord, Show)++-- | Manifest info for a non-scalar type. Scalar types are not part+-- of the manifest for a program.+data Type+ = -- | ctype, Futhark elemtype, rank.+ TypeArray T.Text T.Text Int ArrayOps+ | TypeOpaque T.Text OpaqueOps+ deriving (Eq, Ord, Show)++-- | A manifest for a compiled program.+data Manifest = Manifest+ { -- | A mapping from Futhark entry points to how they are+ -- represented in C.+ manifestEntryPoints :: M.Map T.Text EntryPoint,+ -- | A mapping from Futhark type name to how they are represented+ -- at the C level. Should not contain any of the primitive scalar+ -- types. For array types, these have empty dimensions,+ -- e.g. @[]i32@.+ manifestTypes :: M.Map T.Text Type,+ -- | The compiler backend used to+ -- compile the program, e.g. @c@.+ manifestBackend :: T.Text,+ -- | The version of the compiler used to compile the program.+ manifestVersion :: T.Text+ }+ deriving (Eq, Ord, Show)++instance JSON.ToJSON ArrayOps where+ toJSON (ArrayOps free shape values new) =+ object+ [ ("free", toJSON free),+ ("shape", toJSON shape),+ ("values", toJSON values),+ ("new", toJSON new)+ ]++instance JSON.ToJSON OpaqueOps where+ toJSON (OpaqueOps free store restore) =+ object+ [ ("free", toJSON free),+ ("store", toJSON store),+ ("restore", toJSON restore)+ ]++instance JSON.ToJSON Manifest where+ toJSON (Manifest entry_points types backend version) =+ object+ [ ("backend", toJSON backend),+ ("version", toJSON version),+ ( "entry_points",+ object $ map (bimap JSON.fromText onEntryPoint) $ M.toList entry_points+ ),+ ( "types",+ object $ map (bimap JSON.fromText onType) $ M.toList types+ )+ ]+ where+ onEntryPoint (EntryPoint cfun outputs inputs) =+ object+ [ ("cfun", toJSON cfun),+ ("outputs", toJSON $ map onOutput outputs),+ ("inputs", toJSON $ map onInput inputs)+ ]++ onOutput (Output t u) =+ object+ [ ("type", toJSON t),+ ("unique", toJSON u)+ ]++ onInput (Input p t u) =+ object+ [ ("name", toJSON p),+ ("type", toJSON t),+ ("unique", toJSON u)+ ]++ onType (TypeArray t et rank ops) =+ object+ [ ("kind", "array"),+ ("ctype", toJSON t),+ ("rank", toJSON rank),+ ("elemtype", toJSON et),+ ("ops", toJSON ops)+ ]+ onType (TypeOpaque t ops) =+ object+ [ ("kind", "opaque"),+ ("ctype", toJSON t),+ ("ops", toJSON ops)+ ]++instance JSON.FromJSON ArrayOps where+ parseJSON = JSON.withObject "ArrayOps" $ \v ->+ ArrayOps <$> v .: "free" <*> v .: "shape" <*> v .: "values" <*> v .: "new"++instance JSON.FromJSON OpaqueOps where+ parseJSON = JSON.withObject "OpaqueOps" $ \v ->+ OpaqueOps <$> v .: "free" <*> v .: "store" <*> v .: "restore"++instance JSON.FromJSON EntryPoint where+ parseJSON = JSON.withObject "EntryPoint" $ \v ->+ EntryPoint <$> v .: "cfun" <*> v .: "outputs" <*> v .: "inputs"++instance JSON.FromJSON Output where+ parseJSON = JSON.withObject "Output" $ \v ->+ Output <$> v .: "type" <*> v .: "unique"++instance JSON.FromJSON Input where+ parseJSON = JSON.withObject "Input" $ \v ->+ Input <$> v .: "name" <*> v .: "type" <*> v .: "unique"++instance JSON.FromJSON Type where+ parseJSON = JSON.withObject "Type" $ \ty -> pArray ty <|> pOpaque ty+ where+ pArray ty = do+ guard . (== ("array" :: T.Text)) =<< (ty .: "kind")+ TypeArray <$> ty .: "ctype"+ <*> ty .: "elemtype"+ <*> ty .: "rank"+ <*> ty .: "ops"+ pOpaque ty = do+ guard . (== ("opaque" :: T.Text)) =<< (ty .: "kind")+ TypeOpaque <$> ty .: "ctype" <*> ty .: "ops"++instance JSON.FromJSON Manifest where+ parseJSON = JSON.withObject "Manifest" $ \v ->+ Manifest+ <$> v .: "entry_points"+ <*> v .: "types"+ <*> v .: "backend"+ <*> v .:? "version" .!= "" -- Temporary workaround for older manifests.++-- | Serialise a manifest to JSON.+manifestToJSON :: Manifest -> T.Text+manifestToJSON = toStrict . encodeToLazyText++-- | Read a manifest from JSON. Returns 'Nothing' if the text does+-- not describe a 'Manifest'.+manifestFromJSON :: T.Text -> Maybe Manifest+manifestFromJSON = JSON.decode . toLazyByteString . encodeUtf8Builder
+ tests/Tests.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main (main) where++import Futhark.Manifest+import Test.QuickCheck.Instances.Text ()+import Test.Tasty+import Test.Tasty.QuickCheck++-- These instances may generate manifests that are nonsensical in that+-- the entry points likely refer to nonexistent types. This is fine+-- for testing serialisation.++instance Arbitrary ArrayOps where+ arbitrary = ArrayOps <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary OpaqueOps where+ arbitrary = OpaqueOps <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary Type where+ arbitrary =+ oneof+ [ TypeArray <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary,+ TypeOpaque <$> arbitrary <*> arbitrary+ ]++instance Arbitrary Output where+ arbitrary = Output <$> arbitrary <*> arbitrary++instance Arbitrary Input where+ arbitrary = Input <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary EntryPoint where+ arbitrary = EntryPoint <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary Manifest where+ arbitrary = Manifest <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++jsonTests :: TestTree+jsonTests =+ testGroup+ "JSON"+ [ testProperty "manifestFromJSON . manifestToJSON = id" $+ \v -> manifestFromJSON (manifestToJSON v) == Just v+ ]++allTests :: TestTree+allTests =+ testGroup "" [jsonTests]++main :: IO ()+main = defaultMain allTests