content: {-# LANGUAGE FlexibleInstances #-} -- for IsString with nontrivial parameters
  
  -- | A DSL for constructing primitive function definitions
  module Hydra.Dsl.Prims where
  
  import Hydra.Compute
  import Hydra.Core
  import Hydra.Graph
  import Hydra.Mantle
  import qualified Hydra.Encode.Core as EncodeCore
  import qualified Hydra.Decode.Core as DecodeCore
  import qualified Hydra.Extract.Core as ExtractCore
  import qualified Hydra.Extract.Mantle as ExtractMantle
  import qualified Hydra.Dsl.Terms as Terms
  import qualified Hydra.Dsl.Types as Types
  import qualified Hydra.Show.Core as ShowCore
  
  import Data.Int
  import qualified Data.List as L
  import qualified Data.Map as M
  import qualified Data.Set as S
  import qualified Data.Maybe as Y
  import Hydra.Rewriting (removeTermAnnotations)
  import Data.String(IsString(..))
  
  instance IsString (TermCoder Term) where fromString = variable
  
  bigfloat :: TermCoder Double
  bigfloat = TermCoder Types.bigfloat $ Coder encode decode
    where
      encode = ExtractCore.bigfloat
      decode = pure . Terms.bigfloat
  
  bigint :: TermCoder Integer
  bigint = TermCoder Types.bigint $ Coder encode decode
    where
      encode = ExtractCore.bigint
      decode = pure . Terms.bigint
  
  binary :: TermCoder String
  binary = TermCoder Types.binary $ Coder encode decode
    where
      encode = ExtractCore.binary
      decode = pure . Terms.binary
  
  boolean :: TermCoder Bool
  boolean = TermCoder Types.boolean $ Coder encode decode
    where
      encode = ExtractCore.boolean
      decode = pure . Terms.boolean
  
  comparison :: TermCoder Comparison
  comparison = TermCoder (TypeVariable _Comparison) $ Coder encode decode
    where
      encode = ExtractMantle.comparison
      decode = pure . Terms.comparison
  
  floatType :: TermCoder FloatType
  floatType = TermCoder (TypeVariable _FloatType) $ Coder encode decode
    where
      encode = DecodeCore.floatType
      decode = pure . EncodeCore.floatType
  
  floatValue :: TermCoder FloatValue
  floatValue = TermCoder (TypeVariable _FloatValue) $ Coder encode decode
    where
      encode = ExtractCore.floatValue
      decode = pure . Terms.float
  
  float32 :: TermCoder Float
  float32 = TermCoder Types.float32 $ Coder encode decode
    where
      encode = ExtractCore.float32
      decode = pure . Terms.float32
  
  float64 :: TermCoder Double
  float64 = TermCoder Types.float64 $ Coder encode decode
    where
      encode = ExtractCore.float64
      decode = pure . Terms.float64
  
  flow :: TermCoder s -> TermCoder x -> TermCoder (Flow s x)
  flow states values = TermCoder (TypeVariable _Flow Types.@@ (termCoderType states) Types.@@ (termCoderType values)) $
      Coder encode decode
    where
      encode _ = fail $ "cannot currently encode flows from terms"
      decode _ = fail $ "cannot decode flows to terms"
  
  function :: TermCoder x -> TermCoder y -> TermCoder (x -> y)
  function dom cod = TermCoder (Types.function (termCoderType dom) (termCoderType cod)) $ Coder encode decode
    where
      encode term = fail $ "cannot encode term to a function: " ++ ShowCore.term term
      decode _ = fail $ "cannot decode functions to terms"
  
  integerType :: TermCoder IntegerType
  integerType = TermCoder (TypeVariable _IntegerType) $ Coder encode decode
    where
      encode = DecodeCore.integerType
      decode = pure . EncodeCore.integerType
  
  integerValue :: TermCoder IntegerValue
  integerValue = TermCoder (TypeVariable _IntegerValue) $ Coder encode decode
    where
      encode = ExtractCore.integerValue
      decode = pure . Terms.integer
  
  int8 :: TermCoder Int8
  int8 = TermCoder Types.int8 $ Coder encode decode
    where
      encode = ExtractCore.int8
      decode = pure . Terms.int8
  
  int16 :: TermCoder Int16
  int16 = TermCoder Types.int16 $ Coder encode decode
    where
      encode = ExtractCore.int16
      decode = pure . Terms.int16
  
  int32 :: TermCoder Int
  int32 = TermCoder Types.int32 $ Coder encode decode
    where
      encode = ExtractCore.int32
      decode = pure . Terms.int32
  
  int64 :: TermCoder Int64
  int64 = TermCoder Types.int64 $ Coder encode decode
    where
      encode = ExtractCore.int64
      decode = pure . Terms.int64
  
  list :: TermCoder x -> TermCoder [x]
  list els = TermCoder (Types.list $ termCoderType els) $ Coder encode decode
    where
      encode = ExtractCore.listOf (coderEncode $ termCoderCoder els)
      decode l = Terms.list <$> mapM (coderDecode $ termCoderCoder els) l
  
  literal :: TermCoder Literal
  literal = TermCoder (TypeVariable _Literal) $ Coder encode decode
    where
      encode = ExtractCore.literal
      decode = pure . Terms.literal
  
  literalType :: TermCoder LiteralType
  literalType = TermCoder (TypeVariable _LiteralType) $ Coder encode decode
    where
      encode = DecodeCore.literalType
      decode = pure . EncodeCore.literalType
  
  map :: Ord k => TermCoder k -> TermCoder v -> TermCoder (M.Map k v)
  map keys values = TermCoder (Types.map (termCoderType keys) (termCoderType values)) $ Coder encode decode
    where
      encode = ExtractCore.map (coderEncode $ termCoderCoder keys) (coderEncode $ termCoderCoder values)
      decode m = Terms.map . M.fromList <$> mapM decodePair (M.toList m)
        where
          decodePair (k, v) = do
            ke <- (coderDecode $ termCoderCoder keys) k
            ve <- (coderDecode $ termCoderCoder values) v
            return (ke, ve)
  
  noInterpretedForm :: Name -> Flow Graph Term
  noInterpretedForm name = fail $ "primitive " ++ unName name ++ " does not have an interpreted form; it can only be used in compiled code"
  
  optional :: TermCoder x -> TermCoder (Y.Maybe x)
  optional mel = TermCoder (Types.optional $ termCoderType mel) $ Coder encode decode
    where
      encode = ExtractCore.optional (coderEncode $ termCoderCoder mel)
      decode mv = Terms.optional <$> case mv of
        Nothing -> pure Nothing
        Just v -> Just <$> (coderDecode $ termCoderCoder mel) v
  
  pair :: TermCoder k -> TermCoder v -> TermCoder (k, v)
  pair kCoder vCoder = TermCoder (Types.product [termCoderType kCoder, termCoderType vCoder]) $ Coder encode decode
    where
      encode = ExtractCore.pair (coderEncode $ termCoderCoder kCoder) (coderEncode $ termCoderCoder vCoder)
      decode (k, v) = do
        kTerm <- coderDecode (termCoderCoder kCoder) k
        vTerm <- coderDecode (termCoderCoder vCoder) v
        return $ Terms.tuple [kTerm, vTerm]
  
  prim0 :: Name -> x -> [String]  -> TermCoder x -> Primitive
  prim0 name value vars output = Primitive name typ impl
    where
      typ = Types.poly vars $ termCoderType output
      impl _ = coderDecode (termCoderCoder output) value
  
  prim1 :: Name -> (x -> y) -> [String] -> TermCoder x -> TermCoder y -> Primitive
  prim1 name compute vars input1 output = Primitive name typ impl
    where
      typ = Types.poly vars $ Types.functionMany [
        termCoderType input1,
        termCoderType output]
      impl args = do
        ExtractCore.nArgs name 1 args
        arg1 <- coderEncode (termCoderCoder input1) (args !! 0)
        coderDecode (termCoderCoder output) $ compute arg1
  
  prim2 :: Name -> (x -> y -> z) -> [String] -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive
  prim2 name compute vars input1 input2 output = Primitive name typ impl
    where
      typ = Types.poly vars $ Types.functionMany [
        termCoderType input1,
        termCoderType input2,
        termCoderType output]
      impl args = do
        ExtractCore.nArgs name 2 args
        arg1 <- coderEncode (termCoderCoder input1) (args !! 0)
        arg2 <- coderEncode (termCoderCoder input2) (args !! 1)
        coderDecode (termCoderCoder output) $ compute arg1 arg2
  
  prim2Interp :: Name -> Maybe (Term -> Term -> Flow Graph Term) -> [String] -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive
  prim2Interp name mcompute vars input1 input2 output = Primitive name typ impl
    where
      compute = Y.fromMaybe (\a b -> noInterpretedForm name) mcompute
      typ = Types.poly vars $ Types.functionMany [
        termCoderType input1,
        termCoderType input2,
        termCoderType output]
      impl args = do
        ExtractCore.nArgs name 2 args
        compute (args !! 0) (args !! 1)
  
  prim3 :: Name -> (w -> x -> y -> z) -> [String] -> TermCoder w -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive
  prim3 name compute vars input1 input2 input3 output = Primitive name typ impl
    where
      typ = Types.poly vars $ Types.functionMany [
        termCoderType input1,
        termCoderType input2,
        termCoderType input3,
        termCoderType output]
      impl args = do
        ExtractCore.nArgs name 3 args
        arg1 <- coderEncode (termCoderCoder input1) (args !! 0)
        arg2 <- coderEncode (termCoderCoder input2) (args !! 1)
        arg3 <- coderEncode (termCoderCoder input3) (args !! 2)
        coderDecode (termCoderCoder output) $ compute arg1 arg2 arg3
  
  prim3Interp :: Name -> Maybe (Term -> Term -> Term -> Flow Graph Term) -> [String] -> TermCoder w -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive
  prim3Interp name mcompute vars input1 input2 input3 output = Primitive name typ impl
    where
      compute = Y.fromMaybe (\a b c -> noInterpretedForm name) mcompute
      typ = Types.poly vars $ Types.functionMany [
        termCoderType input1,
        termCoderType input2,
        termCoderType input3,
        termCoderType output]
      impl args = do
        ExtractCore.nArgs name 3 args
        compute (args !! 0) (args !! 1) (args !! 2)
  
  set :: Ord x => TermCoder x -> TermCoder (S.Set x)
  set els = TermCoder (Types.set $ termCoderType els) $ Coder encode decode
    where
      encode = ExtractCore.setOf (coderEncode $ termCoderCoder els)
      decode s = Terms.set . S.fromList <$> mapM (coderDecode $ termCoderCoder els) (S.toList s)
  
  string :: TermCoder String
  string = TermCoder Types.string $ Coder encode decode
    where
      encode = ExtractCore.string
      decode = pure . Terms.string
  
  term :: TermCoder Term
  term = TermCoder (TypeVariable _Term) $ Coder encode decode
    where
      encode = pure
      decode = pure
  
  type_ :: TermCoder Type
  type_ = TermCoder (TypeVariable _Type) $ Coder encode decode
    where
      encode = DecodeCore.type_
      decode = pure . EncodeCore.type_
  
  uint8 :: TermCoder Int16
  uint8 = TermCoder Types.uint8 $ Coder encode decode
    where
      encode = ExtractCore.uint8
      decode = pure . Terms.uint8
  
  uint16 :: TermCoder Int
  uint16 = TermCoder Types.uint16 $ Coder encode decode
    where
      encode = ExtractCore.uint16
      decode = pure . Terms.uint16
  
  uint32 :: TermCoder Int64
  uint32 = TermCoder Types.uint32 $ Coder encode decode
    where
      encode = ExtractCore.uint32
      decode = pure . Terms.uint32
  
  uint64 :: TermCoder Integer
  uint64 = TermCoder Types.uint64 $ Coder encode decode
    where
      encode = ExtractCore.uint64
      decode = pure . Terms.uint64
  
  variable :: String -> TermCoder Term
  variable v = TermCoder (Types.var v) $ Coder encode decode
    where
      encode = pure
      decode = pure
  