{- |
    Module      : $Header$
    Description : Representation of FlatCurry.
    Copyright   : (c) Michael Hanus  2003
                      Martin Engelke 2004
                      Bernd Brassel  2005
    License     : BSD-3-clause

    Maintainer  : bjp@informatik.uni-kiel.de
    Stability   : experimental
    Portability : portable

    This module contains a definition for representing FlatCurry programs
    in Haskell in type 'Prog'.
-}

module Curry.FlatCurry.Type
  ( -- * Representation of qualified names and (type) variables
    QName, VarIndex, TVarIndex, TVarWithKind
    -- * Data types for FlatCurry
  , Visibility (..), Prog (..), TypeDecl (..), TypeExpr (..), Kind (..)
  , ConsDecl (..), NewConsDecl(..), OpDecl (..), Fixity (..)
  , FuncDecl (..), Rule (..), Expr (..), Literal (..)
  , CombType (..), CaseType (..), BranchExpr (..), Pattern (..)
  ) where

import Data.Binary
import Control.Monad

-- ---------------------------------------------------------------------------
-- Qualified names
-- ---------------------------------------------------------------------------

-- |Qualified names.
--
-- In FlatCurry all names are qualified to avoid name clashes.
-- The first component is the module name and the second component the
-- unqualified name as it occurs in the source program.
type QName = (String, String)

-- ---------------------------------------------------------------------------
-- Variable representation
-- ---------------------------------------------------------------------------

-- |Representation of variables.
type VarIndex = Int

-- ---------------------------------------------------------------------------
-- FlatCurry representation
-- ---------------------------------------------------------------------------

-- |Visibility of various entities.
data Visibility
  = Public    -- ^ public (exported) entity
  | Private   -- ^ private entity
    deriving (Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
Eq, ReadPrec [Visibility]
ReadPrec Visibility
Int -> ReadS Visibility
ReadS [Visibility]
(Int -> ReadS Visibility)
-> ReadS [Visibility]
-> ReadPrec Visibility
-> ReadPrec [Visibility]
-> Read Visibility
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Visibility]
$creadListPrec :: ReadPrec [Visibility]
readPrec :: ReadPrec Visibility
$creadPrec :: ReadPrec Visibility
readList :: ReadS [Visibility]
$creadList :: ReadS [Visibility]
readsPrec :: Int -> ReadS Visibility
$creadsPrec :: Int -> ReadS Visibility
Read, Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> String
$cshow :: Visibility -> String
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
Show)

-- |A FlatCurry module.
--
-- A value of this data type has the form
--
-- @Prog modname imports typedecls functions opdecls@
--
-- where
--
-- [@modname@]   Name of this module
-- [@imports@]   List of modules names that are imported
-- [@typedecls@] Type declarations
-- [@funcdecls@] Function declarations
-- [@ opdecls@]  Operator declarations
data Prog = Prog String [String] [TypeDecl] [FuncDecl] [OpDecl]
    deriving (Prog -> Prog -> Bool
(Prog -> Prog -> Bool) -> (Prog -> Prog -> Bool) -> Eq Prog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prog -> Prog -> Bool
$c/= :: Prog -> Prog -> Bool
== :: Prog -> Prog -> Bool
$c== :: Prog -> Prog -> Bool
Eq, ReadPrec [Prog]
ReadPrec Prog
Int -> ReadS Prog
ReadS [Prog]
(Int -> ReadS Prog)
-> ReadS [Prog] -> ReadPrec Prog -> ReadPrec [Prog] -> Read Prog
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Prog]
$creadListPrec :: ReadPrec [Prog]
readPrec :: ReadPrec Prog
$creadPrec :: ReadPrec Prog
readList :: ReadS [Prog]
$creadList :: ReadS [Prog]
readsPrec :: Int -> ReadS Prog
$creadsPrec :: Int -> ReadS Prog
Read, Int -> Prog -> ShowS
[Prog] -> ShowS
Prog -> String
(Int -> Prog -> ShowS)
-> (Prog -> String) -> ([Prog] -> ShowS) -> Show Prog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prog] -> ShowS
$cshowList :: [Prog] -> ShowS
show :: Prog -> String
$cshow :: Prog -> String
showsPrec :: Int -> Prog -> ShowS
$cshowsPrec :: Int -> Prog -> ShowS
Show)

-- |Declaration of algebraic data type or type synonym.
--
-- A data type declaration of the form
--
-- @data t x1...xn = ...| c t1....tkc |...@
--
-- is represented by the FlatCurry term
--
-- @Type t [i1,...,in] [...(Cons c kc [t1,...,tkc])...]@
--
-- where each @ij@ is the index of the type variable @xj@
--
-- /Note:/ The type variable indices are unique inside each type declaration
--         and are usually numbered from 0.
--
-- Thus, a data type declaration consists of the name of the data type,
-- a list of type parameters and a list of constructor declarations.
data TypeDecl
  = Type    QName Visibility [TVarWithKind] [ConsDecl]
  | TypeSyn QName Visibility [TVarWithKind] TypeExpr
  | TypeNew QName Visibility [TVarWithKind] NewConsDecl
    deriving (TypeDecl -> TypeDecl -> Bool
(TypeDecl -> TypeDecl -> Bool)
-> (TypeDecl -> TypeDecl -> Bool) -> Eq TypeDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeDecl -> TypeDecl -> Bool
$c/= :: TypeDecl -> TypeDecl -> Bool
== :: TypeDecl -> TypeDecl -> Bool
$c== :: TypeDecl -> TypeDecl -> Bool
Eq, ReadPrec [TypeDecl]
ReadPrec TypeDecl
Int -> ReadS TypeDecl
ReadS [TypeDecl]
(Int -> ReadS TypeDecl)
-> ReadS [TypeDecl]
-> ReadPrec TypeDecl
-> ReadPrec [TypeDecl]
-> Read TypeDecl
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypeDecl]
$creadListPrec :: ReadPrec [TypeDecl]
readPrec :: ReadPrec TypeDecl
$creadPrec :: ReadPrec TypeDecl
readList :: ReadS [TypeDecl]
$creadList :: ReadS [TypeDecl]
readsPrec :: Int -> ReadS TypeDecl
$creadsPrec :: Int -> ReadS TypeDecl
Read, Int -> TypeDecl -> ShowS
[TypeDecl] -> ShowS
TypeDecl -> String
(Int -> TypeDecl -> ShowS)
-> (TypeDecl -> String) -> ([TypeDecl] -> ShowS) -> Show TypeDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeDecl] -> ShowS
$cshowList :: [TypeDecl] -> ShowS
show :: TypeDecl -> String
$cshow :: TypeDecl -> String
showsPrec :: Int -> TypeDecl -> ShowS
$cshowsPrec :: Int -> TypeDecl -> ShowS
Show)

-- |Type variables are represented by @(TVar i)@ where @i@ is a
-- type variable index.
type TVarIndex = Int

-- |Kinded type variables are represented by a tuple of type variable
-- index and kind.
type TVarWithKind = (TVarIndex, Kind)

-- |A constructor declaration consists of the name and arity of the
-- constructor and a list of the argument types of the constructor.
data ConsDecl = Cons QName Int Visibility [TypeExpr]
    deriving (ConsDecl -> ConsDecl -> Bool
(ConsDecl -> ConsDecl -> Bool)
-> (ConsDecl -> ConsDecl -> Bool) -> Eq ConsDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConsDecl -> ConsDecl -> Bool
$c/= :: ConsDecl -> ConsDecl -> Bool
== :: ConsDecl -> ConsDecl -> Bool
$c== :: ConsDecl -> ConsDecl -> Bool
Eq, ReadPrec [ConsDecl]
ReadPrec ConsDecl
Int -> ReadS ConsDecl
ReadS [ConsDecl]
(Int -> ReadS ConsDecl)
-> ReadS [ConsDecl]
-> ReadPrec ConsDecl
-> ReadPrec [ConsDecl]
-> Read ConsDecl
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConsDecl]
$creadListPrec :: ReadPrec [ConsDecl]
readPrec :: ReadPrec ConsDecl
$creadPrec :: ReadPrec ConsDecl
readList :: ReadS [ConsDecl]
$creadList :: ReadS [ConsDecl]
readsPrec :: Int -> ReadS ConsDecl
$creadsPrec :: Int -> ReadS ConsDecl
Read, Int -> ConsDecl -> ShowS
[ConsDecl] -> ShowS
ConsDecl -> String
(Int -> ConsDecl -> ShowS)
-> (ConsDecl -> String) -> ([ConsDecl] -> ShowS) -> Show ConsDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConsDecl] -> ShowS
$cshowList :: [ConsDecl] -> ShowS
show :: ConsDecl -> String
$cshow :: ConsDecl -> String
showsPrec :: Int -> ConsDecl -> ShowS
$cshowsPrec :: Int -> ConsDecl -> ShowS
Show)

-- |A constructor declaration for a newtype consists
-- of the name of the constructor
-- and the argument type of the constructor.
data NewConsDecl = NewCons QName Visibility TypeExpr
    deriving (NewConsDecl -> NewConsDecl -> Bool
(NewConsDecl -> NewConsDecl -> Bool)
-> (NewConsDecl -> NewConsDecl -> Bool) -> Eq NewConsDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewConsDecl -> NewConsDecl -> Bool
$c/= :: NewConsDecl -> NewConsDecl -> Bool
== :: NewConsDecl -> NewConsDecl -> Bool
$c== :: NewConsDecl -> NewConsDecl -> Bool
Eq, ReadPrec [NewConsDecl]
ReadPrec NewConsDecl
Int -> ReadS NewConsDecl
ReadS [NewConsDecl]
(Int -> ReadS NewConsDecl)
-> ReadS [NewConsDecl]
-> ReadPrec NewConsDecl
-> ReadPrec [NewConsDecl]
-> Read NewConsDecl
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NewConsDecl]
$creadListPrec :: ReadPrec [NewConsDecl]
readPrec :: ReadPrec NewConsDecl
$creadPrec :: ReadPrec NewConsDecl
readList :: ReadS [NewConsDecl]
$creadList :: ReadS [NewConsDecl]
readsPrec :: Int -> ReadS NewConsDecl
$creadsPrec :: Int -> ReadS NewConsDecl
Read, Int -> NewConsDecl -> ShowS
[NewConsDecl] -> ShowS
NewConsDecl -> String
(Int -> NewConsDecl -> ShowS)
-> (NewConsDecl -> String)
-> ([NewConsDecl] -> ShowS)
-> Show NewConsDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewConsDecl] -> ShowS
$cshowList :: [NewConsDecl] -> ShowS
show :: NewConsDecl -> String
$cshow :: NewConsDecl -> String
showsPrec :: Int -> NewConsDecl -> ShowS
$cshowsPrec :: Int -> NewConsDecl -> ShowS
Show)

-- |Type expressions.
--
-- A type expression is either a type variable, a function type,
-- or a type constructor application.
--
-- /Note:/ the names of the predefined type constructors are
-- @Int@, @Float@, @Bool@, @Char@, @IO@, @Success@,
-- @()@ (unit type), @(,...,)@ (tuple types), @[]@ (list type)
data TypeExpr
  = TVar        TVarIndex               -- ^ type variable
  | FuncType    TypeExpr TypeExpr       -- ^ function type @t1 -> t2@
  | TCons QName [TypeExpr]              -- ^ type constructor application
  | ForallType  [TVarWithKind] TypeExpr -- ^ forall type
    deriving (TypeExpr -> TypeExpr -> Bool
(TypeExpr -> TypeExpr -> Bool)
-> (TypeExpr -> TypeExpr -> Bool) -> Eq TypeExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeExpr -> TypeExpr -> Bool
$c/= :: TypeExpr -> TypeExpr -> Bool
== :: TypeExpr -> TypeExpr -> Bool
$c== :: TypeExpr -> TypeExpr -> Bool
Eq, ReadPrec [TypeExpr]
ReadPrec TypeExpr
Int -> ReadS TypeExpr
ReadS [TypeExpr]
(Int -> ReadS TypeExpr)
-> ReadS [TypeExpr]
-> ReadPrec TypeExpr
-> ReadPrec [TypeExpr]
-> Read TypeExpr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypeExpr]
$creadListPrec :: ReadPrec [TypeExpr]
readPrec :: ReadPrec TypeExpr
$creadPrec :: ReadPrec TypeExpr
readList :: ReadS [TypeExpr]
$creadList :: ReadS [TypeExpr]
readsPrec :: Int -> ReadS TypeExpr
$creadsPrec :: Int -> ReadS TypeExpr
Read, Int -> TypeExpr -> ShowS
[TypeExpr] -> ShowS
TypeExpr -> String
(Int -> TypeExpr -> ShowS)
-> (TypeExpr -> String) -> ([TypeExpr] -> ShowS) -> Show TypeExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeExpr] -> ShowS
$cshowList :: [TypeExpr] -> ShowS
show :: TypeExpr -> String
$cshow :: TypeExpr -> String
showsPrec :: Int -> TypeExpr -> ShowS
$cshowsPrec :: Int -> TypeExpr -> ShowS
Show)

-- |Kinds.
--
-- A kind is either * or k_1 -> k_2 where k_1 and k_2 are kinds.
data Kind
  = KStar            -- ^ star kind
  | KArrow Kind Kind -- ^ arrow kind
 deriving (Kind -> Kind -> Bool
(Kind -> Kind -> Bool) -> (Kind -> Kind -> Bool) -> Eq Kind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Kind -> Kind -> Bool
$c/= :: Kind -> Kind -> Bool
== :: Kind -> Kind -> Bool
$c== :: Kind -> Kind -> Bool
Eq, Eq Kind
Eq Kind =>
(Kind -> Kind -> Ordering)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Kind)
-> (Kind -> Kind -> Kind)
-> Ord Kind
Kind -> Kind -> Bool
Kind -> Kind -> Ordering
Kind -> Kind -> Kind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Kind -> Kind -> Kind
$cmin :: Kind -> Kind -> Kind
max :: Kind -> Kind -> Kind
$cmax :: Kind -> Kind -> Kind
>= :: Kind -> Kind -> Bool
$c>= :: Kind -> Kind -> Bool
> :: Kind -> Kind -> Bool
$c> :: Kind -> Kind -> Bool
<= :: Kind -> Kind -> Bool
$c<= :: Kind -> Kind -> Bool
< :: Kind -> Kind -> Bool
$c< :: Kind -> Kind -> Bool
compare :: Kind -> Kind -> Ordering
$ccompare :: Kind -> Kind -> Ordering
$cp1Ord :: Eq Kind
Ord, ReadPrec [Kind]
ReadPrec Kind
Int -> ReadS Kind
ReadS [Kind]
(Int -> ReadS Kind)
-> ReadS [Kind] -> ReadPrec Kind -> ReadPrec [Kind] -> Read Kind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Kind]
$creadListPrec :: ReadPrec [Kind]
readPrec :: ReadPrec Kind
$creadPrec :: ReadPrec Kind
readList :: ReadS [Kind]
$creadList :: ReadS [Kind]
readsPrec :: Int -> ReadS Kind
$creadsPrec :: Int -> ReadS Kind
Read, Int -> Kind -> ShowS
[Kind] -> ShowS
Kind -> String
(Int -> Kind -> ShowS)
-> (Kind -> String) -> ([Kind] -> ShowS) -> Show Kind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kind] -> ShowS
$cshowList :: [Kind] -> ShowS
show :: Kind -> String
$cshow :: Kind -> String
showsPrec :: Int -> Kind -> ShowS
$cshowsPrec :: Int -> Kind -> ShowS
Show)
    
-- |Operator declarations.
--
-- An operator declaration @fix p n@ in Curry corresponds to the
-- FlatCurry term @(Op n fix p)@.
--
-- /Note:/ the constructor definition of 'Op' differs from the original
-- PAKCS definition using Haskell type 'Integer' instead of 'Int'
-- for representing the precedence.
data OpDecl = Op QName Fixity Integer
    deriving (OpDecl -> OpDecl -> Bool
(OpDecl -> OpDecl -> Bool)
-> (OpDecl -> OpDecl -> Bool) -> Eq OpDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpDecl -> OpDecl -> Bool
$c/= :: OpDecl -> OpDecl -> Bool
== :: OpDecl -> OpDecl -> Bool
$c== :: OpDecl -> OpDecl -> Bool
Eq, ReadPrec [OpDecl]
ReadPrec OpDecl
Int -> ReadS OpDecl
ReadS [OpDecl]
(Int -> ReadS OpDecl)
-> ReadS [OpDecl]
-> ReadPrec OpDecl
-> ReadPrec [OpDecl]
-> Read OpDecl
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OpDecl]
$creadListPrec :: ReadPrec [OpDecl]
readPrec :: ReadPrec OpDecl
$creadPrec :: ReadPrec OpDecl
readList :: ReadS [OpDecl]
$creadList :: ReadS [OpDecl]
readsPrec :: Int -> ReadS OpDecl
$creadsPrec :: Int -> ReadS OpDecl
Read, Int -> OpDecl -> ShowS
[OpDecl] -> ShowS
OpDecl -> String
(Int -> OpDecl -> ShowS)
-> (OpDecl -> String) -> ([OpDecl] -> ShowS) -> Show OpDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpDecl] -> ShowS
$cshowList :: [OpDecl] -> ShowS
show :: OpDecl -> String
$cshow :: OpDecl -> String
showsPrec :: Int -> OpDecl -> ShowS
$cshowsPrec :: Int -> OpDecl -> ShowS
Show)

-- |Fixity of an operator.
data Fixity
  = InfixOp  -- ^ non-associative infix operator
  | InfixlOp -- ^ left-associative infix operator
  | InfixrOp -- ^ right-associative infix operator
    deriving (Fixity -> Fixity -> Bool
(Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool) -> Eq Fixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c== :: Fixity -> Fixity -> Bool
Eq, ReadPrec [Fixity]
ReadPrec Fixity
Int -> ReadS Fixity
ReadS [Fixity]
(Int -> ReadS Fixity)
-> ReadS [Fixity]
-> ReadPrec Fixity
-> ReadPrec [Fixity]
-> Read Fixity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Fixity]
$creadListPrec :: ReadPrec [Fixity]
readPrec :: ReadPrec Fixity
$creadPrec :: ReadPrec Fixity
readList :: ReadS [Fixity]
$creadList :: ReadS [Fixity]
readsPrec :: Int -> ReadS Fixity
$creadsPrec :: Int -> ReadS Fixity
Read, Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> String
(Int -> Fixity -> ShowS)
-> (Fixity -> String) -> ([Fixity] -> ShowS) -> Show Fixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> String
$cshow :: Fixity -> String
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> Fixity -> ShowS
Show)

-- |Data type for representing function declarations.
--
-- A function declaration in FlatCurry is a term of the form
--
-- @(Func name arity type (Rule [i_1,...,i_arity] e))@
--
-- and represents the function "name" with definition
--
-- @
-- name :: type
-- name x_1...x_arity = e
-- @
--
-- where each @i_j@ is the index of the variable @x_j@
--
-- /Note:/ The variable indices are unique inside each function declaration
--         and are usually numbered from 0.
--
-- External functions are represented as
--
-- @Func name arity type (External s)@
--
-- where s is the external name associated to this function.
--
-- Thus, a function declaration consists of the name, arity, type, and rule.
data FuncDecl = Func QName Int Visibility TypeExpr Rule
    deriving (FuncDecl -> FuncDecl -> Bool
(FuncDecl -> FuncDecl -> Bool)
-> (FuncDecl -> FuncDecl -> Bool) -> Eq FuncDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FuncDecl -> FuncDecl -> Bool
$c/= :: FuncDecl -> FuncDecl -> Bool
== :: FuncDecl -> FuncDecl -> Bool
$c== :: FuncDecl -> FuncDecl -> Bool
Eq, ReadPrec [FuncDecl]
ReadPrec FuncDecl
Int -> ReadS FuncDecl
ReadS [FuncDecl]
(Int -> ReadS FuncDecl)
-> ReadS [FuncDecl]
-> ReadPrec FuncDecl
-> ReadPrec [FuncDecl]
-> Read FuncDecl
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FuncDecl]
$creadListPrec :: ReadPrec [FuncDecl]
readPrec :: ReadPrec FuncDecl
$creadPrec :: ReadPrec FuncDecl
readList :: ReadS [FuncDecl]
$creadList :: ReadS [FuncDecl]
readsPrec :: Int -> ReadS FuncDecl
$creadsPrec :: Int -> ReadS FuncDecl
Read, Int -> FuncDecl -> ShowS
[FuncDecl] -> ShowS
FuncDecl -> String
(Int -> FuncDecl -> ShowS)
-> (FuncDecl -> String) -> ([FuncDecl] -> ShowS) -> Show FuncDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuncDecl] -> ShowS
$cshowList :: [FuncDecl] -> ShowS
show :: FuncDecl -> String
$cshow :: FuncDecl -> String
showsPrec :: Int -> FuncDecl -> ShowS
$cshowsPrec :: Int -> FuncDecl -> ShowS
Show)

-- |A rule is either a list of formal parameters together with an expression
-- or an 'External' tag.
data Rule
  = Rule [VarIndex] Expr
  | External String
    deriving (Rule -> Rule -> Bool
(Rule -> Rule -> Bool) -> (Rule -> Rule -> Bool) -> Eq Rule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rule -> Rule -> Bool
$c/= :: Rule -> Rule -> Bool
== :: Rule -> Rule -> Bool
$c== :: Rule -> Rule -> Bool
Eq, ReadPrec [Rule]
ReadPrec Rule
Int -> ReadS Rule
ReadS [Rule]
(Int -> ReadS Rule)
-> ReadS [Rule] -> ReadPrec Rule -> ReadPrec [Rule] -> Read Rule
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rule]
$creadListPrec :: ReadPrec [Rule]
readPrec :: ReadPrec Rule
$creadPrec :: ReadPrec Rule
readList :: ReadS [Rule]
$creadList :: ReadS [Rule]
readsPrec :: Int -> ReadS Rule
$creadsPrec :: Int -> ReadS Rule
Read, Int -> Rule -> ShowS
[Rule] -> ShowS
Rule -> String
(Int -> Rule -> ShowS)
-> (Rule -> String) -> ([Rule] -> ShowS) -> Show Rule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rule] -> ShowS
$cshowList :: [Rule] -> ShowS
show :: Rule -> String
$cshow :: Rule -> String
showsPrec :: Int -> Rule -> ShowS
$cshowsPrec :: Int -> Rule -> ShowS
Show)

-- |Data type for representing expressions.
--
-- Remarks:
--
-- 1.if-then-else expressions are represented as function calls:
--
--   @(if e1 then e2 else e3)@
--
--   is represented as
--
--   @(Comb FuncCall ("Prelude","ifThenElse") [e1,e2,e3])@
--
-- 2.Higher order applications are represented as calls to the (external)
--   function @apply@. For instance, the rule
--
--   @app f x = f x@
--
--   is represented as
--
--   @(Rule  [0,1] (Comb FuncCall ("Prelude","apply") [Var 0, Var 1]))@
--
-- 3.A conditional rule is represented as a call to an external function
--   @cond@ where the first argument is the condition (a constraint).
--
--   For instance, the rule
--
--   @equal2 x | x=:=2 = success@
--
--   is represented as
--
--   @
--   (Rule [0]
--       (Comb FuncCall ("Prelude","cond")
--             [Comb FuncCall ("Prelude","=:=") [Var 0, Lit (Intc 2)],
--             Comb FuncCall ("Prelude","success") []]))
--   @
--
-- 4.Functions with evaluation annotation @choice@ are represented
--   by a rule whose right-hand side is enclosed in a call to the
--   external function @Prelude.commit@.
--   Furthermore, all rules of the original definition must be
--   represented by conditional expressions (i.e., (cond [c,e]))
--   after pattern matching.
--
--   Example:
--
--   @
--   m eval choice
--   m [] y = y
--   m x [] = x
--   @
--
--   is translated into (note that the conditional branches can be also
--   wrapped with Free declarations in general):
--
--   @
--   Rule [0,1]
--     (Comb FuncCall ("Prelude","commit")
--       [Or (Case Rigid (Var 0)
--             [(Pattern ("Prelude","[]") []
--                 (Comb FuncCall ("Prelude","cond")
--                       [Comb FuncCall ("Prelude","success") [],
--                         Var 1]))] )
--           (Case Rigid (Var 1)
--             [(Pattern ("Prelude","[]") []
--                 (Comb FuncCall ("Prelude","cond")
--                       [Comb FuncCall ("Prelude","success") [],
--                         Var 0]))] )])
--   @
--
--   Operational meaning of @(Prelude.commit e)@:
--   evaluate @e@ with local search spaces and commit to the first
--   @(Comb FuncCall ("Prelude","cond") [c,ge])@ in @e@ whose constraint @c@
--   is satisfied
data Expr
  -- |Variable, represented by unique index
  = Var VarIndex
  -- |Literal (Integer/Float/Char constant)
  | Lit Literal
  -- |Application @(f e1 ... en)@ of function/constructor @f@
  --  with @n <= arity f@
  | Comb CombType QName [Expr]
  -- |Introduction of free local variables for an expression
  | Free [VarIndex] Expr
  -- |Local let-declarations
  | Let [(VarIndex, Expr)] Expr
  -- |Disjunction of two expressions
  -- (resulting from overlapping left-hand sides)
  | Or Expr Expr
  -- |case expression
  | Case CaseType Expr [BranchExpr]
  -- |typed expression
  | Typed Expr TypeExpr
    deriving (Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq, ReadPrec [Expr]
ReadPrec Expr
Int -> ReadS Expr
ReadS [Expr]
(Int -> ReadS Expr)
-> ReadS [Expr] -> ReadPrec Expr -> ReadPrec [Expr] -> Read Expr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expr]
$creadListPrec :: ReadPrec [Expr]
readPrec :: ReadPrec Expr
$creadPrec :: ReadPrec Expr
readList :: ReadS [Expr]
$creadList :: ReadS [Expr]
readsPrec :: Int -> ReadS Expr
$creadsPrec :: Int -> ReadS Expr
Read, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show)

-- |Data type for representing literals.
--
-- A literal  is either an integer, a float, or a character constant.
--
-- /Note:/ The constructor definition of 'Intc' differs from the original
-- PAKCS definition. It uses Haskell type 'Integer' instead of 'Int'
-- to provide an unlimited range of integer numbers. Furthermore,
-- float values are represented with Haskell type 'Double' instead of
-- 'Float'.
data Literal
  = Intc   Integer
  | Floatc Double
  | Charc  Char
    deriving (Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq, ReadPrec [Literal]
ReadPrec Literal
Int -> ReadS Literal
ReadS [Literal]
(Int -> ReadS Literal)
-> ReadS [Literal]
-> ReadPrec Literal
-> ReadPrec [Literal]
-> Read Literal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Literal]
$creadListPrec :: ReadPrec [Literal]
readPrec :: ReadPrec Literal
$creadPrec :: ReadPrec Literal
readList :: ReadS [Literal]
$creadList :: ReadS [Literal]
readsPrec :: Int -> ReadS Literal
$creadsPrec :: Int -> ReadS Literal
Read, Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
(Int -> Literal -> ShowS)
-> (Literal -> String) -> ([Literal] -> ShowS) -> Show Literal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Literal] -> ShowS
$cshowList :: [Literal] -> ShowS
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> ShowS
$cshowsPrec :: Int -> Literal -> ShowS
Show)

-- |Data type for classifying combinations
-- (i.e., a function/constructor applied to some arguments).
data CombType
  -- |a call to a function where all arguments are provided
  = FuncCall
  -- |a call with a constructor at the top, all arguments are provided
  | ConsCall
  -- |a partial call to a function (i.e., not all arguments are provided)
  --  where the parameter is the number of missing arguments
  | FuncPartCall Int
  -- |a partial call to a constructor along with number of missing arguments
  | ConsPartCall Int
    deriving (CombType -> CombType -> Bool
(CombType -> CombType -> Bool)
-> (CombType -> CombType -> Bool) -> Eq CombType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CombType -> CombType -> Bool
$c/= :: CombType -> CombType -> Bool
== :: CombType -> CombType -> Bool
$c== :: CombType -> CombType -> Bool
Eq, ReadPrec [CombType]
ReadPrec CombType
Int -> ReadS CombType
ReadS [CombType]
(Int -> ReadS CombType)
-> ReadS [CombType]
-> ReadPrec CombType
-> ReadPrec [CombType]
-> Read CombType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CombType]
$creadListPrec :: ReadPrec [CombType]
readPrec :: ReadPrec CombType
$creadPrec :: ReadPrec CombType
readList :: ReadS [CombType]
$creadList :: ReadS [CombType]
readsPrec :: Int -> ReadS CombType
$creadsPrec :: Int -> ReadS CombType
Read, Int -> CombType -> ShowS
[CombType] -> ShowS
CombType -> String
(Int -> CombType -> ShowS)
-> (CombType -> String) -> ([CombType] -> ShowS) -> Show CombType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CombType] -> ShowS
$cshowList :: [CombType] -> ShowS
show :: CombType -> String
$cshow :: CombType -> String
showsPrec :: Int -> CombType -> ShowS
$cshowsPrec :: Int -> CombType -> ShowS
Show)

-- |Classification of case expressions, either flexible or rigid.
data CaseType
  = Rigid
  | Flex
    deriving (CaseType -> CaseType -> Bool
(CaseType -> CaseType -> Bool)
-> (CaseType -> CaseType -> Bool) -> Eq CaseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseType -> CaseType -> Bool
$c/= :: CaseType -> CaseType -> Bool
== :: CaseType -> CaseType -> Bool
$c== :: CaseType -> CaseType -> Bool
Eq, ReadPrec [CaseType]
ReadPrec CaseType
Int -> ReadS CaseType
ReadS [CaseType]
(Int -> ReadS CaseType)
-> ReadS [CaseType]
-> ReadPrec CaseType
-> ReadPrec [CaseType]
-> Read CaseType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CaseType]
$creadListPrec :: ReadPrec [CaseType]
readPrec :: ReadPrec CaseType
$creadPrec :: ReadPrec CaseType
readList :: ReadS [CaseType]
$creadList :: ReadS [CaseType]
readsPrec :: Int -> ReadS CaseType
$creadsPrec :: Int -> ReadS CaseType
Read, Int -> CaseType -> ShowS
[CaseType] -> ShowS
CaseType -> String
(Int -> CaseType -> ShowS)
-> (CaseType -> String) -> ([CaseType] -> ShowS) -> Show CaseType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseType] -> ShowS
$cshowList :: [CaseType] -> ShowS
show :: CaseType -> String
$cshow :: CaseType -> String
showsPrec :: Int -> CaseType -> ShowS
$cshowsPrec :: Int -> CaseType -> ShowS
Show)

-- |Branches in a case expression.
--
-- Branches @(m.c x1...xn) -> e@ in case expressions are represented as
--
-- @(Branch (Pattern (m,c) [i1,...,in]) e)@
--
-- where each @ij@ is the index of the pattern variable @xj@, or as
--
-- @(Branch (LPattern (Intc i)) e)@
--
-- for integers as branch patterns (similarly for other literals
-- like float or character constants).
data BranchExpr = Branch Pattern Expr
    deriving (BranchExpr -> BranchExpr -> Bool
(BranchExpr -> BranchExpr -> Bool)
-> (BranchExpr -> BranchExpr -> Bool) -> Eq BranchExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BranchExpr -> BranchExpr -> Bool
$c/= :: BranchExpr -> BranchExpr -> Bool
== :: BranchExpr -> BranchExpr -> Bool
$c== :: BranchExpr -> BranchExpr -> Bool
Eq, ReadPrec [BranchExpr]
ReadPrec BranchExpr
Int -> ReadS BranchExpr
ReadS [BranchExpr]
(Int -> ReadS BranchExpr)
-> ReadS [BranchExpr]
-> ReadPrec BranchExpr
-> ReadPrec [BranchExpr]
-> Read BranchExpr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BranchExpr]
$creadListPrec :: ReadPrec [BranchExpr]
readPrec :: ReadPrec BranchExpr
$creadPrec :: ReadPrec BranchExpr
readList :: ReadS [BranchExpr]
$creadList :: ReadS [BranchExpr]
readsPrec :: Int -> ReadS BranchExpr
$creadsPrec :: Int -> ReadS BranchExpr
Read, Int -> BranchExpr -> ShowS
[BranchExpr] -> ShowS
BranchExpr -> String
(Int -> BranchExpr -> ShowS)
-> (BranchExpr -> String)
-> ([BranchExpr] -> ShowS)
-> Show BranchExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BranchExpr] -> ShowS
$cshowList :: [BranchExpr] -> ShowS
show :: BranchExpr -> String
$cshow :: BranchExpr -> String
showsPrec :: Int -> BranchExpr -> ShowS
$cshowsPrec :: Int -> BranchExpr -> ShowS
Show)

-- |Patterns in case expressions.
data Pattern
  = Pattern QName [VarIndex]
  | LPattern Literal
    deriving (Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq, ReadPrec [Pattern]
ReadPrec Pattern
Int -> ReadS Pattern
ReadS [Pattern]
(Int -> ReadS Pattern)
-> ReadS [Pattern]
-> ReadPrec Pattern
-> ReadPrec [Pattern]
-> Read Pattern
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pattern]
$creadListPrec :: ReadPrec [Pattern]
readPrec :: ReadPrec Pattern
$creadPrec :: ReadPrec Pattern
readList :: ReadS [Pattern]
$creadList :: ReadS [Pattern]
readsPrec :: Int -> ReadS Pattern
$creadsPrec :: Int -> ReadS Pattern
Read, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
(Int -> Pattern -> ShowS)
-> (Pattern -> String) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> String
$cshow :: Pattern -> String
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show)

instance Binary Visibility where
  put :: Visibility -> Put
put Public  = Word8 -> Put
putWord8 0
  put Private = Word8 -> Put
putWord8 1

  get :: Get Visibility
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> Visibility -> Get Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Public
      1 -> Visibility -> Get Visibility
forall (m :: * -> *) a. Monad m => a -> m a
return Visibility
Private
      _ -> String -> Get Visibility
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for Visibility"

instance Binary Prog where
  put :: Prog -> Put
put (Prog mid :: String
mid im :: [String]
im tys :: [TypeDecl]
tys fus :: [FuncDecl]
fus ops :: [OpDecl]
ops) =
    String -> Put
forall t. Binary t => t -> Put
put String
mid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> Put
forall t. Binary t => t -> Put
put [String]
im Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TypeDecl] -> Put
forall t. Binary t => t -> Put
put [TypeDecl]
tys Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [FuncDecl] -> Put
forall t. Binary t => t -> Put
put [FuncDecl]
fus Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [OpDecl] -> Put
forall t. Binary t => t -> Put
put [OpDecl]
ops
  get :: Get Prog
get = String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog
Prog (String
 -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog)
-> Get String
-> Get ([String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get Get ([String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog)
-> Get [String]
-> Get ([TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [String]
forall t. Binary t => Get t
get Get ([TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog)
-> Get [TypeDecl] -> Get ([FuncDecl] -> [OpDecl] -> Prog)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [TypeDecl]
forall t. Binary t => Get t
get Get ([FuncDecl] -> [OpDecl] -> Prog)
-> Get [FuncDecl] -> Get ([OpDecl] -> Prog)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [FuncDecl]
forall t. Binary t => Get t
get Get ([OpDecl] -> Prog) -> Get [OpDecl] -> Get Prog
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [OpDecl]
forall t. Binary t => Get t
get

instance Binary TypeDecl where
  put :: TypeDecl -> Put
put (Type    qid :: QName
qid vis :: Visibility
vis vs :: [TVarWithKind]
vs cs :: [ConsDecl]
cs) =
    Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Visibility -> Put
forall t. Binary t => t -> Put
put Visibility
vis Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TVarWithKind] -> Put
forall t. Binary t => t -> Put
put [TVarWithKind]
vs Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ConsDecl] -> Put
forall t. Binary t => t -> Put
put [ConsDecl]
cs
  put (TypeSyn qid :: QName
qid vis :: Visibility
vis vs :: [TVarWithKind]
vs ty :: TypeExpr
ty) =
    Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Visibility -> Put
forall t. Binary t => t -> Put
put Visibility
vis Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TVarWithKind] -> Put
forall t. Binary t => t -> Put
put [TVarWithKind]
vs Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> Put
forall t. Binary t => t -> Put
put TypeExpr
ty
  put (TypeNew qid :: QName
qid vis :: Visibility
vis vs :: [TVarWithKind]
vs c :: NewConsDecl
c ) =
    Word8 -> Put
putWord8 2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Visibility -> Put
forall t. Binary t => t -> Put
put Visibility
vis Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TVarWithKind] -> Put
forall t. Binary t => t -> Put
put [TVarWithKind]
vs Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NewConsDecl -> Put
forall t. Binary t => t -> Put
put NewConsDecl
c

  get :: Get TypeDecl
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> (QName -> Visibility -> [TVarWithKind] -> [ConsDecl] -> TypeDecl)
-> Get QName
-> Get Visibility
-> Get [TVarWithKind]
-> Get [ConsDecl]
-> Get TypeDecl
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 QName -> Visibility -> [TVarWithKind] -> [ConsDecl] -> TypeDecl
Type Get QName
forall t. Binary t => Get t
get Get Visibility
forall t. Binary t => Get t
get Get [TVarWithKind]
forall t. Binary t => Get t
get Get [ConsDecl]
forall t. Binary t => Get t
get
      1 -> (QName -> Visibility -> [TVarWithKind] -> TypeExpr -> TypeDecl)
-> Get QName
-> Get Visibility
-> Get [TVarWithKind]
-> Get TypeExpr
-> Get TypeDecl
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 QName -> Visibility -> [TVarWithKind] -> TypeExpr -> TypeDecl
TypeSyn Get QName
forall t. Binary t => Get t
get Get Visibility
forall t. Binary t => Get t
get Get [TVarWithKind]
forall t. Binary t => Get t
get Get TypeExpr
forall t. Binary t => Get t
get
      2 -> (QName -> Visibility -> [TVarWithKind] -> NewConsDecl -> TypeDecl)
-> Get QName
-> Get Visibility
-> Get [TVarWithKind]
-> Get NewConsDecl
-> Get TypeDecl
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 QName -> Visibility -> [TVarWithKind] -> NewConsDecl -> TypeDecl
TypeNew Get QName
forall t. Binary t => Get t
get Get Visibility
forall t. Binary t => Get t
get Get [TVarWithKind]
forall t. Binary t => Get t
get Get NewConsDecl
forall t. Binary t => Get t
get
      _ -> String -> Get TypeDecl
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for TypeDecl"

instance Binary ConsDecl where
  put :: ConsDecl -> Put
put (Cons qid :: QName
qid arity :: Int
arity vis :: Visibility
vis tys :: [TypeExpr]
tys) = QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
arity Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Visibility -> Put
forall t. Binary t => t -> Put
put Visibility
vis Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TypeExpr] -> Put
forall t. Binary t => t -> Put
put [TypeExpr]
tys
  get :: Get ConsDecl
get = QName -> Int -> Visibility -> [TypeExpr] -> ConsDecl
Cons (QName -> Int -> Visibility -> [TypeExpr] -> ConsDecl)
-> Get QName -> Get (Int -> Visibility -> [TypeExpr] -> ConsDecl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get QName
forall t. Binary t => Get t
get Get (Int -> Visibility -> [TypeExpr] -> ConsDecl)
-> Get Int -> Get (Visibility -> [TypeExpr] -> ConsDecl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Visibility -> [TypeExpr] -> ConsDecl)
-> Get Visibility -> Get ([TypeExpr] -> ConsDecl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Visibility
forall t. Binary t => Get t
get Get ([TypeExpr] -> ConsDecl) -> Get [TypeExpr] -> Get ConsDecl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [TypeExpr]
forall t. Binary t => Get t
get

instance Binary NewConsDecl where
  put :: NewConsDecl -> Put
put (NewCons qid :: QName
qid vis :: Visibility
vis ty :: TypeExpr
ty) = QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Visibility -> Put
forall t. Binary t => t -> Put
put Visibility
vis Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> Put
forall t. Binary t => t -> Put
put TypeExpr
ty
  get :: Get NewConsDecl
get = QName -> Visibility -> TypeExpr -> NewConsDecl
NewCons (QName -> Visibility -> TypeExpr -> NewConsDecl)
-> Get QName -> Get (Visibility -> TypeExpr -> NewConsDecl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get QName
forall t. Binary t => Get t
get Get (Visibility -> TypeExpr -> NewConsDecl)
-> Get Visibility -> Get (TypeExpr -> NewConsDecl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Visibility
forall t. Binary t => Get t
get Get (TypeExpr -> NewConsDecl) -> Get TypeExpr -> Get NewConsDecl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeExpr
forall t. Binary t => Get t
get

instance Binary TypeExpr where
  put :: TypeExpr -> Put
put (TVar tv :: Int
tv) =
    Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
tv
  put (FuncType ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) =
    Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> Put
forall t. Binary t => t -> Put
put TypeExpr
ty1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> Put
forall t. Binary t => t -> Put
put TypeExpr
ty2
  put (TCons qid :: QName
qid tys :: [TypeExpr]
tys) =
    Word8 -> Put
putWord8 2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TypeExpr] -> Put
forall t. Binary t => t -> Put
put [TypeExpr]
tys
  put (ForallType vs :: [TVarWithKind]
vs ty :: TypeExpr
ty) =
    Word8 -> Put
putWord8 3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TVarWithKind] -> Put
forall t. Binary t => t -> Put
put [TVarWithKind]
vs Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> Put
forall t. Binary t => t -> Put
put TypeExpr
ty

  get :: Get TypeExpr
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> (Int -> TypeExpr) -> Get Int -> Get TypeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> TypeExpr
TVar Get Int
forall t. Binary t => Get t
get
      1 -> (TypeExpr -> TypeExpr -> TypeExpr)
-> Get TypeExpr -> Get TypeExpr -> Get TypeExpr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 TypeExpr -> TypeExpr -> TypeExpr
FuncType Get TypeExpr
forall t. Binary t => Get t
get Get TypeExpr
forall t. Binary t => Get t
get
      2 -> (QName -> [TypeExpr] -> TypeExpr)
-> Get QName -> Get [TypeExpr] -> Get TypeExpr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 QName -> [TypeExpr] -> TypeExpr
TCons Get QName
forall t. Binary t => Get t
get Get [TypeExpr]
forall t. Binary t => Get t
get
      3 -> ([TVarWithKind] -> TypeExpr -> TypeExpr)
-> Get [TVarWithKind] -> Get TypeExpr -> Get TypeExpr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [TVarWithKind] -> TypeExpr -> TypeExpr
ForallType Get [TVarWithKind]
forall t. Binary t => Get t
get Get TypeExpr
forall t. Binary t => Get t
get
      _ -> String -> Get TypeExpr
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for TypeExpr"

instance Binary Kind where
  put :: Kind -> Put
put KStar          = Word8 -> Put
putWord8 0
  put (KArrow k1 :: Kind
k1 k2 :: Kind
k2) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Kind -> Put
forall t. Binary t => t -> Put
put Kind
k1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Kind -> Put
forall t. Binary t => t -> Put
put Kind
k2
  get :: Get Kind
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> Kind -> Get Kind
forall (m :: * -> *) a. Monad m => a -> m a
return Kind
KStar
      1 -> (Kind -> Kind -> Kind) -> Get Kind -> Get Kind -> Get Kind
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Kind -> Kind -> Kind
KArrow Get Kind
forall t. Binary t => Get t
get Get Kind
forall t. Binary t => Get t
get
      _ -> String -> Get Kind
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for Kind"

instance Binary OpDecl where
  put :: OpDecl -> Put
put (Op qid :: QName
qid fix :: Fixity
fix pr :: Integer
pr) = QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fixity -> Put
forall t. Binary t => t -> Put
put Fixity
fix Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Put
forall t. Binary t => t -> Put
put Integer
pr
  get :: Get OpDecl
get = (QName -> Fixity -> Integer -> OpDecl)
-> Get QName -> Get Fixity -> Get Integer -> Get OpDecl
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 QName -> Fixity -> Integer -> OpDecl
Op Get QName
forall t. Binary t => Get t
get Get Fixity
forall t. Binary t => Get t
get Get Integer
forall t. Binary t => Get t
get

instance Binary Fixity where
  put :: Fixity -> Put
put InfixOp  = Word8 -> Put
putWord8 0
  put InfixlOp = Word8 -> Put
putWord8 1
  put InfixrOp = Word8 -> Put
putWord8 2

  get :: Get Fixity
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> Fixity -> Get Fixity
forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
InfixOp
      1 -> Fixity -> Get Fixity
forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
InfixlOp
      2 -> Fixity -> Get Fixity
forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
InfixrOp
      _ -> String -> Get Fixity
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for Fixity"

instance Binary FuncDecl where
  put :: FuncDecl -> Put
put (Func qid :: QName
qid arity :: Int
arity vis :: Visibility
vis ty :: TypeExpr
ty r :: Rule
r) =
    QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
arity Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Visibility -> Put
forall t. Binary t => t -> Put
put Visibility
vis Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> Put
forall t. Binary t => t -> Put
put TypeExpr
ty Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rule -> Put
forall t. Binary t => t -> Put
put Rule
r
  get :: Get FuncDecl
get = QName -> Int -> Visibility -> TypeExpr -> Rule -> FuncDecl
Func (QName -> Int -> Visibility -> TypeExpr -> Rule -> FuncDecl)
-> Get QName
-> Get (Int -> Visibility -> TypeExpr -> Rule -> FuncDecl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get QName
forall t. Binary t => Get t
get Get (Int -> Visibility -> TypeExpr -> Rule -> FuncDecl)
-> Get Int -> Get (Visibility -> TypeExpr -> Rule -> FuncDecl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Visibility -> TypeExpr -> Rule -> FuncDecl)
-> Get Visibility -> Get (TypeExpr -> Rule -> FuncDecl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Visibility
forall t. Binary t => Get t
get Get (TypeExpr -> Rule -> FuncDecl)
-> Get TypeExpr -> Get (Rule -> FuncDecl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeExpr
forall t. Binary t => Get t
get Get (Rule -> FuncDecl) -> Get Rule -> Get FuncDecl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Rule
forall t. Binary t => Get t
get

instance Binary Rule where
  put :: Rule -> Put
put (Rule     alts :: [Int]
alts e :: Expr
e) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> Put
forall t. Binary t => t -> Put
put [Int]
alts Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Put
forall t. Binary t => t -> Put
put Expr
e
  put (External n :: String
n     ) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
n

  get :: Get Rule
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> ([Int] -> Expr -> Rule) -> Get [Int] -> Get Expr -> Get Rule
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [Int] -> Expr -> Rule
Rule Get [Int]
forall t. Binary t => Get t
get Get Expr
forall t. Binary t => Get t
get
      1 -> (String -> Rule) -> Get String -> Get Rule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Rule
External Get String
forall t. Binary t => Get t
get
      _ -> String -> Get Rule
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for TRule"

instance Binary Expr where
  put :: Expr -> Put
put (Var v :: Int
v) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
v
  put (Lit l :: Literal
l) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Literal -> Put
forall t. Binary t => t -> Put
put Literal
l
  put (Comb cty :: CombType
cty qid :: QName
qid es :: [Expr]
es) =
    Word8 -> Put
putWord8 2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CombType -> Put
forall t. Binary t => t -> Put
put CombType
cty Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Expr] -> Put
forall t. Binary t => t -> Put
put [Expr]
es
  put (Let  bs :: [(Int, Expr)]
bs e :: Expr
e) = Word8 -> Put
putWord8 3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Int, Expr)] -> Put
forall t. Binary t => t -> Put
put [(Int, Expr)]
bs Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Put
forall t. Binary t => t -> Put
put Expr
e
  put (Free vs :: [Int]
vs e :: Expr
e) = Word8 -> Put
putWord8 4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> Put
forall t. Binary t => t -> Put
put [Int]
vs Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Put
forall t. Binary t => t -> Put
put Expr
e
  put (Or  e1 :: Expr
e1 e2 :: Expr
e2) = Word8 -> Put
putWord8 5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Put
forall t. Binary t => t -> Put
put Expr
e1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Put
forall t. Binary t => t -> Put
put Expr
e2
  put (Case cty :: CaseType
cty ty :: Expr
ty as :: [BranchExpr]
as) = Word8 -> Put
putWord8 6 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CaseType -> Put
forall t. Binary t => t -> Put
put CaseType
cty Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Put
forall t. Binary t => t -> Put
put Expr
ty Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [BranchExpr] -> Put
forall t. Binary t => t -> Put
put [BranchExpr]
as
  put (Typed e :: Expr
e ty :: TypeExpr
ty) = Word8 -> Put
putWord8 7 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Put
forall t. Binary t => t -> Put
put Expr
e Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeExpr -> Put
forall t. Binary t => t -> Put
put TypeExpr
ty

  get :: Get Expr
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> (Int -> Expr) -> Get Int -> Get Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Expr
Var Get Int
forall t. Binary t => Get t
get
      1 -> (Literal -> Expr) -> Get Literal -> Get Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Literal -> Expr
Lit Get Literal
forall t. Binary t => Get t
get
      2 -> (CombType -> QName -> [Expr] -> Expr)
-> Get CombType -> Get QName -> Get [Expr] -> Get Expr
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 CombType -> QName -> [Expr] -> Expr
Comb Get CombType
forall t. Binary t => Get t
get Get QName
forall t. Binary t => Get t
get Get [Expr]
forall t. Binary t => Get t
get
      3 -> ([(Int, Expr)] -> Expr -> Expr)
-> Get [(Int, Expr)] -> Get Expr -> Get Expr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [(Int, Expr)] -> Expr -> Expr
Let Get [(Int, Expr)]
forall t. Binary t => Get t
get Get Expr
forall t. Binary t => Get t
get
      4 -> ([Int] -> Expr -> Expr) -> Get [Int] -> Get Expr -> Get Expr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [Int] -> Expr -> Expr
Free Get [Int]
forall t. Binary t => Get t
get Get Expr
forall t. Binary t => Get t
get
      5 -> (Expr -> Expr -> Expr) -> Get Expr -> Get Expr -> Get Expr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Expr -> Expr -> Expr
Or Get Expr
forall t. Binary t => Get t
get Get Expr
forall t. Binary t => Get t
get
      6 -> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> Get CaseType -> Get Expr -> Get [BranchExpr] -> Get Expr
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 CaseType -> Expr -> [BranchExpr] -> Expr
Case Get CaseType
forall t. Binary t => Get t
get Get Expr
forall t. Binary t => Get t
get Get [BranchExpr]
forall t. Binary t => Get t
get
      7 -> (Expr -> TypeExpr -> Expr) -> Get Expr -> Get TypeExpr -> Get Expr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Expr -> TypeExpr -> Expr
Typed Get Expr
forall t. Binary t => Get t
get Get TypeExpr
forall t. Binary t => Get t
get
      _ -> String -> Get Expr
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for TExpr"

instance Binary BranchExpr where
  put :: BranchExpr -> Put
put (Branch p :: Pattern
p e :: Expr
e) = Pattern -> Put
forall t. Binary t => t -> Put
put Pattern
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Put
forall t. Binary t => t -> Put
put Expr
e
  get :: Get BranchExpr
get = (Pattern -> Expr -> BranchExpr)
-> Get Pattern -> Get Expr -> Get BranchExpr
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Pattern -> Expr -> BranchExpr
Branch Get Pattern
forall t. Binary t => Get t
get Get Expr
forall t. Binary t => Get t
get

instance Binary Pattern where
  put :: Pattern -> Put
put (Pattern  qid :: QName
qid vs :: [Int]
vs) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> QName -> Put
forall t. Binary t => t -> Put
put QName
qid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> Put
forall t. Binary t => t -> Put
put [Int]
vs
  put (LPattern l :: Literal
l     ) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Literal -> Put
forall t. Binary t => t -> Put
put Literal
l

  get :: Get Pattern
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> (QName -> [Int] -> Pattern)
-> Get QName -> Get [Int] -> Get Pattern
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 QName -> [Int] -> Pattern
Pattern Get QName
forall t. Binary t => Get t
get Get [Int]
forall t. Binary t => Get t
get
      1 -> (Literal -> Pattern) -> Get Literal -> Get Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Literal -> Pattern
LPattern Get Literal
forall t. Binary t => Get t
get
      _ -> String -> Get Pattern
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for TPattern"

instance Binary Literal where
  put :: Literal -> Put
put (Intc   i :: Integer
i) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Put
forall t. Binary t => t -> Put
put Integer
i
  put (Floatc f :: Double
f) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
f
  put (Charc  c :: Char
c) = Word8 -> Put
putWord8 2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Put
forall t. Binary t => t -> Put
put Char
c

  get :: Get Literal
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> (Integer -> Literal) -> Get Integer -> Get Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Literal
Intc Get Integer
forall t. Binary t => Get t
get
      1 -> (Double -> Literal) -> Get Double -> Get Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Literal
Floatc Get Double
forall t. Binary t => Get t
get
      2 -> (Char -> Literal) -> Get Char -> Get Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Literal
Charc Get Char
forall t. Binary t => Get t
get
      _ -> String -> Get Literal
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for Literal"

instance Binary CombType where
  put :: CombType -> Put
put FuncCall = Word8 -> Put
putWord8 0
  put ConsCall = Word8 -> Put
putWord8 1
  put (FuncPartCall i :: Int
i) = Word8 -> Put
putWord8 2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
i
  put (ConsPartCall i :: Int
i) = Word8 -> Put
putWord8 3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
i

  get :: Get CombType
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> CombType -> Get CombType
forall (m :: * -> *) a. Monad m => a -> m a
return CombType
FuncCall
      1 -> CombType -> Get CombType
forall (m :: * -> *) a. Monad m => a -> m a
return CombType
ConsCall
      2 -> (Int -> CombType) -> Get Int -> Get CombType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CombType
FuncPartCall Get Int
forall t. Binary t => Get t
get
      3 -> (Int -> CombType) -> Get Int -> Get CombType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CombType
ConsPartCall Get Int
forall t. Binary t => Get t
get
      _ -> String -> Get CombType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for CombType"

instance Binary CaseType where
  put :: CaseType -> Put
put Rigid = Word8 -> Put
putWord8 0
  put Flex  = Word8 -> Put
putWord8 1

  get :: Get CaseType
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> CaseType -> Get CaseType
forall (m :: * -> *) a. Monad m => a -> m a
return CaseType
Rigid
      1 -> CaseType -> Get CaseType
forall (m :: * -> *) a. Monad m => a -> m a
return CaseType
Flex
      _ -> String -> Get CaseType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for CaseType"