{-# LINE 1 "PGF2/Internal.hsc" #-}
{-# LANGUAGE ImplicitParams, RankNTypes #-}

module PGF2.Internal(-- * Access the internal structures
                     FId,isPredefFId,
                     FunId,Token,Production(..),PArg(..),Symbol(..),Literal(..),
                     globalFlags, abstrFlags, concrFlags,
                     concrTotalCats, concrCategories, concrProductions,
                     concrTotalFuns, concrFunction,
                     concrTotalSeqs, concrSequence,

                     -- * Building new PGFs in memory
                     build, eAbs, eApp, eMeta, eFun, eVar, eTyped, eImplArg, dTyp, hypo,
                     AbstrInfo, newAbstr, ConcrInfo, newConcr, newPGF,

                     -- * Expose PGF and Concr for FFI with C
                     PGF(..), Concr(..),

                     -- * Write an in-memory PGF to a file
                     writePGF
                    ) where



import PGF2
import PGF2.FFI
import PGF2.Expr
import PGF2.Type
import System.IO.Unsafe(unsafePerformIO)
import Foreign
import Foreign.C
import Data.IORef
import Data.Maybe(fromMaybe)
import Data.List(sortBy)
import Control.Exception(Exception,throwIO)
import Control.Monad(foldM)
import qualified Data.Map as Map

type Token  = String
type LIndex = Int
data Symbol
  = SymCat {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex
  | SymLit {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex
  | SymVar {-# UNPACK #-} !Int {-# UNPACK #-} !Int
  | SymKS Token
  | SymKP [Symbol] [([Symbol],[String])]
  | SymBIND                         -- the special BIND token
  | SymNE                           -- non exist
  | SymSOFT_BIND                    -- the special SOFT_BIND token
  | SymSOFT_SPACE                   -- the special SOFT_SPACE token
  | SymCAPIT                        -- the special CAPIT token
  | SymALL_CAPIT                    -- the special ALL_CAPIT token
  deriving (Eq,Ord,Show)
data Production
  = PApply  {-# UNPACK #-} !FunId [PArg]
  | PCoerce {-# UNPACK #-} !FId
  deriving (Eq,Ord,Show)
type FunId = Int
type SeqId = Int
data Literal =
   LStr String                      -- ^ a string constant
 | LInt Int                         -- ^ an integer constant
 | LFlt Double                      -- ^ a floating point constant
 deriving (Eq,Ord,Show)


-----------------------------------------------------------------------
-- Access the internal structures
-----------------------------------------------------------------------

globalFlags :: PGF -> [(String,Literal)]
globalFlags p = unsafePerformIO $ do
  c_flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) (pgf p)
{-# LINE 73 "PGF2/Internal.hsc" #-}
  flags   <- peekFlags c_flags
  touchPGF p
  return flags

abstrFlags :: PGF -> [(String,Literal)]
abstrFlags p = unsafePerformIO $ do
  c_flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) (pgf p)
{-# LINE 80 "PGF2/Internal.hsc" #-}
  flags   <- peekFlags c_flags
  touchPGF p
  return flags

concrFlags :: Concr -> [(String,Literal)]
concrFlags c = unsafePerformIO $ do
  c_flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) (concr c)
{-# LINE 87 "PGF2/Internal.hsc" #-}
  flags   <- peekFlags c_flags
  touchConcr c
  return flags

peekFlags :: Ptr GuSeq -> IO [(String,Literal)]
peekFlags c_flags = do
  c_len <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) c_flags
{-# LINE 94 "PGF2/Internal.hsc" #-}
  peekFlags (c_len :: CInt) (c_flags `plusPtr` ((8)))
{-# LINE 95 "PGF2/Internal.hsc" #-}
  where
    peekFlags 0     ptr = return []
    peekFlags c_len ptr = do
      name  <- ((\hsc_ptr -> peekByteOff hsc_ptr 0))  ptr >>= peekUtf8CString
{-# LINE 99 "PGF2/Internal.hsc" #-}
      value <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr >>= peekLiteral
{-# LINE 100 "PGF2/Internal.hsc" #-}
      flags <- peekFlags (c_len-1) (ptr `plusPtr` ((16)))
{-# LINE 101 "PGF2/Internal.hsc" #-}
      return ((name,value):flags)

peekLiteral :: GuVariant -> IO Literal
peekLiteral p = do
  tag <- gu_variant_tag  p
  ptr <- gu_variant_data p
  case tag of
    (0) -> do { val <- peekUtf8CString (ptr `plusPtr` ((0)));
{-# LINE 109 "PGF2/Internal.hsc" #-}
                                     return (LStr val) }
    (1) -> do { val <- peek (ptr `plusPtr` ((0)));
{-# LINE 111 "PGF2/Internal.hsc" #-}
                                     return (LInt (fromIntegral (val :: CInt))) }
    (2) -> do { val <- peek (ptr `plusPtr` ((0)));
{-# LINE 113 "PGF2/Internal.hsc" #-}
                                     return (LFlt (realToFrac (val :: CDouble))) }
    _                        -> error "Unknown literal type in the grammar"

concrTotalCats :: Concr -> FId
concrTotalCats c = unsafePerformIO $ do
  c_total_cats <- ((\hsc_ptr -> peekByteOff hsc_ptr 80)) (concr c)
{-# LINE 119 "PGF2/Internal.hsc" #-}
  touchConcr c
  return (fromIntegral (c_total_cats :: CInt))

concrCategories :: Concr -> [(Cat,FId,FId,[String])]
concrCategories c =
  unsafePerformIO $
    withGuPool $ \tmpPl ->
    allocaBytes ((8)) $ \itor -> do
{-# LINE 127 "PGF2/Internal.hsc" #-}
      exn <- gu_new_exn tmpPl
      ref <- newIORef []
      fptr <- wrapMapItorCallback (getCategories ref)
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) itor fptr
{-# LINE 131 "PGF2/Internal.hsc" #-}
      c_cnccats <- ((\hsc_ptr -> peekByteOff hsc_ptr 72)) (concr c)
{-# LINE 132 "PGF2/Internal.hsc" #-}
      gu_map_iter c_cnccats itor exn
      touchConcr c
      freeHaskellFunPtr fptr
      cs <- readIORef ref
      return (reverse cs)
  where
    getCategories ref itor key value exn = do
      names <- readIORef ref
      name  <- peekUtf8CString (castPtr key)
      c_cnccat <- peek (castPtr value)
      c_cats <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) c_cnccat
{-# LINE 143 "PGF2/Internal.hsc" #-}
      c_len <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) c_cats
{-# LINE 144 "PGF2/Internal.hsc" #-}
      first <- peek (c_cats `plusPtr` ((8))) >>= peekFId
{-# LINE 145 "PGF2/Internal.hsc" #-}
      last  <- peek (c_cats `plusPtr` (((8)) + (fromIntegral (c_len-1::CSizeT))*((8)))) >>= peekFId
{-# LINE 146 "PGF2/Internal.hsc" #-}
      c_n_lins <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) c_cnccat
{-# LINE 147 "PGF2/Internal.hsc" #-}
      arr <- peekArray (fromIntegral (c_n_lins :: CSizeT)) (c_cnccat `plusPtr` ((24)))
{-# LINE 148 "PGF2/Internal.hsc" #-}
      labels <- mapM peekUtf8CString arr
      writeIORef ref ((name,first,last,labels) : names)

concrProductions :: Concr -> FId -> [Production]
concrProductions c fid = unsafePerformIO $ do
  c_ccats <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) (concr c)
{-# LINE 154 "PGF2/Internal.hsc" #-}
  res <- alloca $ \pfid -> do
           poke pfid (fromIntegral fid :: CInt)
           gu_map_find_default c_ccats pfid >>= peek
  if res == nullPtr
    then do touchConcr c
            return []
    else do c_prods <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) res
{-# LINE 161 "PGF2/Internal.hsc" #-}
            if c_prods == nullPtr
              then do touchConcr c
                      return []
              else do res <- peekSequence (deRef peekProduction) ((8)) c_prods
{-# LINE 165 "PGF2/Internal.hsc" #-}
                      touchConcr c
                      return res
  where
    peekProduction p = do
      tag <- gu_variant_tag  p
      dt  <- gu_variant_data p
      case tag of
        (0) -> do { c_cncfun <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) dt ;
{-# LINE 173 "PGF2/Internal.hsc" #-}
                                              c_funid  <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) c_cncfun ;
{-# LINE 174 "PGF2/Internal.hsc" #-}
                                              c_args   <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) dt ;
{-# LINE 175 "PGF2/Internal.hsc" #-}
                                              pargs <- peekSequence peekPArg ((16)) c_args ;
{-# LINE 176 "PGF2/Internal.hsc" #-}
                                              return (PApply (fromIntegral (c_funid :: CInt)) pargs) }
        (1)-> do { c_coerce <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) dt ;
{-# LINE 178 "PGF2/Internal.hsc" #-}
                                              fid <- peekFId c_coerce ;
                                              return (PCoerce fid) }
        _                             -> error "Unknown production type in the grammar"
      where
        peekPArg ptr = do
          c_hypos <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 184 "PGF2/Internal.hsc" #-}
          hypos <- peekSequence (deRef peekFId) ((4)) c_hypos
{-# LINE 185 "PGF2/Internal.hsc" #-}
          c_ccat <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 186 "PGF2/Internal.hsc" #-}
          fid  <- peekFId c_ccat
          return (PArg hypos fid)

concrTotalFuns :: Concr -> FunId
concrTotalFuns c = unsafePerformIO $ do
  c_cncfuns <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) (concr c)
{-# LINE 192 "PGF2/Internal.hsc" #-}
  c_len <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) c_cncfuns
{-# LINE 193 "PGF2/Internal.hsc" #-}
  touchConcr c
  return (fromIntegral (c_len :: CSizeT))

concrFunction :: Concr -> FunId -> (Fun,[SeqId])
concrFunction c funid = unsafePerformIO $ do
  c_cncfuns <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) (concr c)
{-# LINE 199 "PGF2/Internal.hsc" #-}
  c_cncfun <- peek (c_cncfuns `plusPtr` (((8))+funid*((8))))
{-# LINE 200 "PGF2/Internal.hsc" #-}
  c_absfun <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) c_cncfun
{-# LINE 201 "PGF2/Internal.hsc" #-}
  c_name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) c_absfun
{-# LINE 202 "PGF2/Internal.hsc" #-}
  name <- peekUtf8CString c_name
  c_n_lins <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) c_cncfun
{-# LINE 204 "PGF2/Internal.hsc" #-}
  arr <- peekArray (fromIntegral (c_n_lins :: CSizeT)) (c_cncfun `plusPtr` ((32)))
{-# LINE 205 "PGF2/Internal.hsc" #-}
  seqs_seq <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) (concr c)
{-# LINE 206 "PGF2/Internal.hsc" #-}
  touchConcr c
  let seqs = seqs_seq `plusPtr` ((8))
{-# LINE 208 "PGF2/Internal.hsc" #-}
  return (name, map (toSeqId seqs) arr)
  where
    toSeqId seqs seq = minusPtr seq seqs `div` ((16))
{-# LINE 211 "PGF2/Internal.hsc" #-}

concrTotalSeqs :: Concr -> SeqId
concrTotalSeqs c = unsafePerformIO $ do
  seq <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) (concr c)
{-# LINE 215 "PGF2/Internal.hsc" #-}
  c_len <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) seq
{-# LINE 216 "PGF2/Internal.hsc" #-}
  touchConcr c
  return (fromIntegral (c_len :: CSizeT))

concrSequence :: Concr -> SeqId -> [Symbol]
concrSequence c seqid = unsafePerformIO $ do
  c_sequences <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) (concr c)
{-# LINE 222 "PGF2/Internal.hsc" #-}
  let c_sequence = c_sequences `plusPtr` (((8))+seqid*((16)))
{-# LINE 223 "PGF2/Internal.hsc" #-}
  c_syms <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) c_sequence
{-# LINE 224 "PGF2/Internal.hsc" #-}
  res <- peekSequence (deRef peekSymbol) ((8)) c_syms
{-# LINE 225 "PGF2/Internal.hsc" #-}
  touchConcr c
  return res
  where
    peekSymbol p = do
      tag <- gu_variant_tag  p
      dt  <- gu_variant_data p
      case tag of
        (0)        -> peekSymbolIdx SymCat dt
{-# LINE 233 "PGF2/Internal.hsc" #-}
        (1)        -> peekSymbolIdx SymLit dt
{-# LINE 234 "PGF2/Internal.hsc" #-}
        (2)        -> peekSymbolIdx SymVar dt
{-# LINE 235 "PGF2/Internal.hsc" #-}
        (3)         -> peekSymbolKS dt
{-# LINE 236 "PGF2/Internal.hsc" #-}
        (4)         -> peekSymbolKP dt
{-# LINE 237 "PGF2/Internal.hsc" #-}
        (5)       -> return SymBIND
{-# LINE 238 "PGF2/Internal.hsc" #-}
        (6)  -> return SymSOFT_BIND
{-# LINE 239 "PGF2/Internal.hsc" #-}
        (7)         -> return SymNE
{-# LINE 240 "PGF2/Internal.hsc" #-}
        (8) -> return SymSOFT_SPACE
{-# LINE 241 "PGF2/Internal.hsc" #-}
        (9)      -> return SymCAPIT
{-# LINE 242 "PGF2/Internal.hsc" #-}
        (10)  -> return SymALL_CAPIT
{-# LINE 243 "PGF2/Internal.hsc" #-}
        _                              -> error "Unknown symbol type in the grammar"

    peekSymbolIdx constr dt = do
      c_d <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) dt
{-# LINE 247 "PGF2/Internal.hsc" #-}
      c_r <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) dt
{-# LINE 248 "PGF2/Internal.hsc" #-}
      return (constr (fromIntegral (c_d :: CInt)) (fromIntegral (c_r :: CInt)))

    peekSymbolKS dt = do
      token <- peekUtf8CString (dt `plusPtr` ((0)))
{-# LINE 252 "PGF2/Internal.hsc" #-}
      return (SymKS token)

    peekSymbolKP dt = do
      c_default_form <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) dt
{-# LINE 256 "PGF2/Internal.hsc" #-}
      default_form <- peekSequence (deRef peekSymbol) ((8)) c_default_form
{-# LINE 257 "PGF2/Internal.hsc" #-}
      c_n_forms <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) dt
{-# LINE 258 "PGF2/Internal.hsc" #-}
      forms <- peekForms (c_n_forms :: CSizeT) (dt `plusPtr` ((16)))
{-# LINE 259 "PGF2/Internal.hsc" #-}
      return (SymKP default_form forms)

    peekForms 0   ptr = return []
    peekForms len ptr = do
      c_form <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 264 "PGF2/Internal.hsc" #-}
      form <- peekSequence (deRef peekSymbol) ((8)) c_form
{-# LINE 265 "PGF2/Internal.hsc" #-}
      c_prefixes <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 266 "PGF2/Internal.hsc" #-}
      prefixes <- peekSequence (deRef peekUtf8CString) ((8)) c_prefixes
{-# LINE 267 "PGF2/Internal.hsc" #-}
      forms <- peekForms (len-1) (ptr `plusPtr` ((16)))
{-# LINE 268 "PGF2/Internal.hsc" #-}
      return ((form,prefixes):forms)

fidString, fidInt, fidFloat, fidVar, fidStart :: FId
fidString = (-1)
fidInt    = (-2)
fidFloat  = (-3)
fidVar    = (-4)
fidStart  = (-5)

isPredefFId :: FId -> Bool
isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar])


-----------------------------------------------------------------------
-- Building new PGFs in memory
-----------------------------------------------------------------------

data Builder s = Builder (Ptr GuPool) Touch
newtype B s a = B a

build :: (forall s . (?builder :: Builder s) => B s a) -> a
build f =
  unsafePerformIO $ do
    pool <- gu_new_pool
    poolFPtr <- newForeignPtr gu_pool_finalizer pool
    let ?builder = Builder pool (touchForeignPtr poolFPtr)
    let B res = f
    return res

eAbs :: (?builder :: Builder s) => BindType -> String -> B s Expr -> B s Expr
eAbs bind_type var (B (Expr body _)) =
  unsafePerformIO $
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (0)
{-# LINE 302 "PGF2/Internal.hsc" #-}
                            ((24))
{-# LINE 303 "PGF2/Internal.hsc" #-}
                            (8)
{-# LINE 304 "PGF2/Internal.hsc" #-}
                            pptr pool
    cvar <- newUtf8CString var pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (cbind_type :: PgfBindType)
{-# LINE 307 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr cvar
{-# LINE 308 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr body
{-# LINE 309 "PGF2/Internal.hsc" #-}
    e <- peek pptr
    return (B (Expr e touch))
  where
    (Builder pool touch) = ?builder

    cbind_type =
      case bind_type of
        Explicit -> (0)
{-# LINE 317 "PGF2/Internal.hsc" #-}
        Implicit -> (1)
{-# LINE 318 "PGF2/Internal.hsc" #-}

eApp :: (?builder :: Builder s) => B s Expr -> B s Expr -> B s Expr
eApp (B (Expr fun _)) (B (Expr arg _)) =
  unsafePerformIO $
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (1)
{-# LINE 324 "PGF2/Internal.hsc" #-}
                            ((16))
{-# LINE 325 "PGF2/Internal.hsc" #-}
                            (8)
{-# LINE 326 "PGF2/Internal.hsc" #-}
                            pptr pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr fun
{-# LINE 328 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr arg
{-# LINE 329 "PGF2/Internal.hsc" #-}
    e <- peek pptr
    return (B (Expr e touch))
  where
    (Builder pool touch) = ?builder

eMeta :: (?builder :: Builder s) => Int -> B s Expr
eMeta id =
  unsafePerformIO $
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (3)
{-# LINE 339 "PGF2/Internal.hsc" #-}
                            (fromIntegral ((4)))
{-# LINE 340 "PGF2/Internal.hsc" #-}
                            (4)
{-# LINE 341 "PGF2/Internal.hsc" #-}
                            pptr pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (fromIntegral id :: CInt)
{-# LINE 343 "PGF2/Internal.hsc" #-}
    e <- peek pptr
    return (B (Expr e touch))
  where
    (Builder pool touch) = ?builder

eFun :: (?builder :: Builder s) => Fun -> B s Expr
eFun fun =
  unsafePerformIO $
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (4)
{-# LINE 353 "PGF2/Internal.hsc" #-}
                            (fromIntegral (((0))+utf8Length fun))
{-# LINE 354 "PGF2/Internal.hsc" #-}
                            (0)
{-# LINE 355 "PGF2/Internal.hsc" #-}
                            pptr pool
    pokeUtf8CString fun (ptr `plusPtr` ((0)))
{-# LINE 357 "PGF2/Internal.hsc" #-}
    e <- peek pptr
    return (B (Expr e touch))
  where
    (Builder pool touch) = ?builder

eVar :: (?builder :: Builder s) => Int -> B s Expr
eVar var =
  unsafePerformIO $
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (5)
{-# LINE 367 "PGF2/Internal.hsc" #-}
                            ((4))
{-# LINE 368 "PGF2/Internal.hsc" #-}
                            (4)
{-# LINE 369 "PGF2/Internal.hsc" #-}
                            pptr pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (fromIntegral var :: CInt)
{-# LINE 371 "PGF2/Internal.hsc" #-}
    e <- peek pptr
    return (B (Expr e touch))
  where
    (Builder pool touch) = ?builder

eTyped :: (?builder :: Builder s) => B s Expr -> B s Type -> B s Expr
eTyped (B (Expr e _)) (B (Type ty _)) =
  unsafePerformIO $
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (6)
{-# LINE 381 "PGF2/Internal.hsc" #-}
                            ((16))
{-# LINE 382 "PGF2/Internal.hsc" #-}
                            (8)
{-# LINE 383 "PGF2/Internal.hsc" #-}
                            pptr pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr e
{-# LINE 385 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr ty
{-# LINE 386 "PGF2/Internal.hsc" #-}
    e <- peek pptr
    return (B (Expr e touch))
  where
    (Builder pool touch) = ?builder

eImplArg :: (?builder :: Builder s) => B s Expr -> B s Expr
eImplArg (B (Expr e _)) =
  unsafePerformIO $
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (7)
{-# LINE 396 "PGF2/Internal.hsc" #-}
                            ((8))
{-# LINE 397 "PGF2/Internal.hsc" #-}
                            (8)
{-# LINE 398 "PGF2/Internal.hsc" #-}
                            pptr pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr e
{-# LINE 400 "PGF2/Internal.hsc" #-}
    e <- peek pptr
    return (B (Expr e touch))
  where
    (Builder pool touch) = ?builder

hypo :: BindType -> CId -> B s Type -> (B s Hypo)
hypo bind_type var (B ty) = B (bind_type,var,ty)

dTyp :: (?builder :: Builder s) => [B s Hypo] -> Cat -> [B s Expr] -> B s Type
dTyp hypos cat es =
  unsafePerformIO $ do
    ptr <- gu_malloc_aligned pool
                             (((24))+n_exprs*((8)))
{-# LINE 413 "PGF2/Internal.hsc" #-}
                             (0)
{-# LINE 414 "PGF2/Internal.hsc" #-}
    c_hypos <- newHypos hypos pool
    c_cat <- newUtf8CString cat pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0))   ptr c_hypos
{-# LINE 417 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8))     ptr c_cat
{-# LINE 418 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr n_exprs
{-# LINE 419 "PGF2/Internal.hsc" #-}
    pokeArray (ptr `plusPtr` ((24))) [e | B (Expr e _) <- es]
{-# LINE 420 "PGF2/Internal.hsc" #-}
    return (B (Type ptr touch))
  where
    (Builder pool touch) = ?builder
    n_exprs = fromIntegral (length es) :: CSizeT

newHypos :: [B s Hypo] -> Ptr GuPool -> IO (Ptr GuSeq)
newHypos hypos pool = do
  c_hypos <- gu_make_seq ((24)) (fromIntegral (length hypos)) pool
{-# LINE 428 "PGF2/Internal.hsc" #-}
  pokeHypos (c_hypos `plusPtr` ((8))) hypos
{-# LINE 429 "PGF2/Internal.hsc" #-}
  return c_hypos
  where
    pokeHypos ptr []                                  = return ()
    pokeHypos ptr (B (bind_type,var,Type ty _):hypos) = do
      c_var <- newUtf8CString var pool
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (cbind_type :: PgfBindType)
{-# LINE 435 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8))       ptr c_var
{-# LINE 436 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 16))      ptr ty
{-# LINE 437 "PGF2/Internal.hsc" #-}
      pokeHypos (ptr `plusPtr` ((24))) hypos
{-# LINE 438 "PGF2/Internal.hsc" #-}
      where
        cbind_type =
          case bind_type of
            Explicit -> (0)
{-# LINE 442 "PGF2/Internal.hsc" #-}
            Implicit -> (1)
{-# LINE 443 "PGF2/Internal.hsc" #-}


data AbstrInfo = AbstrInfo (Ptr GuSeq) (Ptr GuSeq) (Map.Map String (Ptr PgfAbsCat)) (Ptr GuSeq) (Map.Map String (Ptr PgfAbsFun)) (Ptr PgfAbsFun) (Ptr GuBuf) Touch

newAbstr :: (?builder :: Builder s) => [(String,Literal)] ->
                                       [(Cat,[B s Hypo],Float)] ->
                                       [(Fun,B s Type,Int,Float)] ->
                                       AbstrInfo
newAbstr aflags cats funs = unsafePerformIO $ do
  c_aflags <- newFlags aflags pool
  (c_cats,abscats) <- newAbsCats (sortByFst3 cats) pool
  (c_funs,absfuns) <- newAbsFuns (sortByFst4 funs) pool
  c_abs_lin_fun <- newAbsLinFun
  c_non_lexical_buf <- gu_make_buf ((24)) pool
{-# LINE 457 "PGF2/Internal.hsc" #-}
  return (AbstrInfo c_aflags c_cats abscats c_funs absfuns c_abs_lin_fun c_non_lexical_buf touch)
  where
    (Builder pool touch) = ?builder

    newAbsCats values pool = do
      c_seq <- gu_make_seq ((32)) (fromIntegral (length values)) pool
{-# LINE 463 "PGF2/Internal.hsc" #-}
      abscats <- pokeElems (c_seq `plusPtr` ((8))) Map.empty values
{-# LINE 464 "PGF2/Internal.hsc" #-}
      return (c_seq,abscats)
      where
        pokeElems ptr abscats []     = return abscats
        pokeElems ptr abscats (x:xs) = do
          abscats <- pokeAbsCat ptr abscats x
          pokeElems (ptr `plusPtr` ((32))) abscats xs
{-# LINE 470 "PGF2/Internal.hsc" #-}

    pokeAbsCat ptr abscats (name,hypos,prob) = do
      c_name  <- newUtf8CString name pool
      c_hypos <- newHypos hypos pool
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr c_name
{-# LINE 475 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr c_hypos
{-# LINE 476 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (realToFrac prob :: CFloat)
{-# LINE 477 "PGF2/Internal.hsc" #-}
      return (Map.insert name ptr abscats)

    newAbsFuns values pool = do
      c_seq <- gu_make_seq ((72)) (fromIntegral (length values)) pool
{-# LINE 481 "PGF2/Internal.hsc" #-}
      absfuns <- pokeElems (c_seq `plusPtr` ((8))) Map.empty values
{-# LINE 482 "PGF2/Internal.hsc" #-}
      return (c_seq,absfuns)
      where
        pokeElems ptr absfuns []     = return absfuns
        pokeElems ptr absfuns (x:xs) = do
          absfuns <- pokeAbsFun ptr absfuns x
          pokeElems (ptr `plusPtr` ((72))) absfuns xs
{-# LINE 488 "PGF2/Internal.hsc" #-}

    pokeAbsFun ptr absfuns (name,B (Type c_ty _),arity,prob) = do
      pfun <- gu_alloc_variant (4)
{-# LINE 491 "PGF2/Internal.hsc" #-}
                               (fromIntegral (((0))+utf8Length name))
{-# LINE 492 "PGF2/Internal.hsc" #-}
                               (0)
{-# LINE 493 "PGF2/Internal.hsc" #-}
                               (ptr `plusPtr` ((40))) pool
{-# LINE 494 "PGF2/Internal.hsc" #-}
      let c_name = (pfun `plusPtr` ((0)))
{-# LINE 495 "PGF2/Internal.hsc" #-}
      pokeUtf8CString name c_name
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr c_name
{-# LINE 497 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr c_ty
{-# LINE 498 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (fromIntegral arity :: CInt)
{-# LINE 499 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr nullPtr
{-# LINE 500 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (realToFrac prob :: CFloat)
{-# LINE 501 "PGF2/Internal.hsc" #-}
      return (Map.insert name ptr absfuns)

    newAbsLinFun = do
      ptr <- gu_malloc_aligned pool
                               ((72))
{-# LINE 506 "PGF2/Internal.hsc" #-}
                               (8)
{-# LINE 507 "PGF2/Internal.hsc" #-}
      c_wild <- newUtf8CString "_" pool
      c_ty   <- gu_malloc_aligned pool
                                  ((24))
{-# LINE 510 "PGF2/Internal.hsc" #-}
                                  (8)
{-# LINE 511 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0))   c_ty nullPtr
{-# LINE 512 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8))     c_ty c_wild
{-# LINE 513 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) c_ty (0 :: CSizeT)
{-# LINE 514 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0))    ptr c_wild
{-# LINE 515 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8))    ptr c_ty
{-# LINE 516 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 16))   ptr (0 :: CSizeT)
{-# LINE 517 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 24))   ptr nullPtr
{-# LINE 518 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (- log 0 :: CFloat)
{-# LINE 519 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr nullPtr
{-# LINE 520 "PGF2/Internal.hsc" #-}
      return ptr


data ConcrInfo = ConcrInfo (Ptr GuSeq) (Ptr GuMap) (Ptr GuMap) (Ptr GuSeq) (Ptr GuSeq) (Ptr GuMap) (Ptr PgfConcr -> Ptr GuPool -> IO ()) CInt

newConcr :: (?builder :: Builder s) => AbstrInfo
                                    -> [(String,Literal)]        -- ^ Concrete syntax flags
                                    -> [(String,String)]         -- ^ Printnames
                                    -> [(FId,[FunId])]           -- ^ Lindefs
                                    -> [(FId,[FunId])]           -- ^ Linrefs
                                    -> [(FId,[Production])]      -- ^ Productions
                                    -> [(Fun,[SeqId])]           -- ^ Concrete functions   (must be sorted by Fun)
                                    -> [[Symbol]]                -- ^ Sequences            (must be sorted)
                                    -> [(Cat,FId,FId,[String])]  -- ^ Concrete categories
                                    -> FId                       -- ^ The total count of the categories
                                    -> ConcrInfo
newConcr (AbstrInfo _ _ abscats  _ absfuns c_abs_lin_fun c_non_lexical_buf _) cflags printnames lindefs linrefs prods cncfuns sequences cnccats total_cats = unsafePerformIO $ do
  c_cflags <- newFlags cflags pool
  c_printname <- newMap ((8)) gu_string_hasher newUtf8CString
{-# LINE 539 "PGF2/Internal.hsc" #-}
                        ((8)) (pokeString pool)
{-# LINE 540 "PGF2/Internal.hsc" #-}
                        printnames pool
  c_seqs <- newSequence ((16)) pokeSequence sequences pool
{-# LINE 542 "PGF2/Internal.hsc" #-}
  let seqs_ptr = c_seqs `plusPtr` ((8))
{-# LINE 543 "PGF2/Internal.hsc" #-}
  c_cncfuns <- newSequence ((8)) (pokeCncFun seqs_ptr) (zip [0..] cncfuns) pool
{-# LINE 544 "PGF2/Internal.hsc" #-}
  let funs_ptr = c_cncfuns `plusPtr` ((8))
{-# LINE 545 "PGF2/Internal.hsc" #-}
  c_ccats <- gu_make_map ((4)) gu_int_hasher
{-# LINE 546 "PGF2/Internal.hsc" #-}
                         ((8)) gu_null_struct
{-# LINE 547 "PGF2/Internal.hsc" #-}
                         (11)
{-# LINE 548 "PGF2/Internal.hsc" #-}
                         pool
  mapM_ (addLindefs c_ccats funs_ptr) lindefs
  mapM_ (addLinrefs c_ccats funs_ptr) linrefs
  mk_index <- foldM (addProductions c_ccats funs_ptr c_non_lexical_buf) (\concr pool -> return ()) prods
  c_cnccats <- newMap ((8)) gu_string_hasher newUtf8CString ((8)) (pokeCncCat c_ccats) (map (\v@(k,_,_,_) -> (k,v)) cnccats) pool
{-# LINE 553 "PGF2/Internal.hsc" #-}
  return (ConcrInfo c_cflags c_printname c_ccats c_cncfuns c_seqs c_cnccats mk_index (fromIntegral total_cats))
  where
    (Builder pool touch) = ?builder

    pokeCncFun seqs_ptr ptr cncfun = do
      c_cncfun <- newCncFun absfuns nullPtr cncfun pool
      poke ptr c_cncfun

    pokeSequence c_seq syms = do
      c_syms <- newSymbols syms pool
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) c_seq c_syms
{-# LINE 564 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8))  c_seq nullPtr
{-# LINE 565 "PGF2/Internal.hsc" #-}

    addLindefs c_ccats funs_ptr (fid,funids) = do
      c_ccat <- getCCat c_ccats fid pool
      c_funs <- newSequence ((8)) (pokeRefDefFunId funs_ptr) funids pool
{-# LINE 569 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) c_ccat c_funs
{-# LINE 570 "PGF2/Internal.hsc" #-}

    addLinrefs c_ccats funs_ptr (fid,funids) = do
      c_ccat <- getCCat c_ccats fid pool
      c_funs <- newSequence ((8)) (pokeRefDefFunId funs_ptr) funids pool
{-# LINE 574 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) c_ccat c_funs
{-# LINE 575 "PGF2/Internal.hsc" #-}

    addProductions c_ccats funs_ptr c_non_lexical_buf mk_index (fid,prods) = do
      c_ccat <- getCCat c_ccats fid pool
      let n_prods = length prods
      c_prods <- gu_make_seq ((8)) (fromIntegral n_prods) pool
{-# LINE 580 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) c_ccat c_prods
{-# LINE 581 "PGF2/Internal.hsc" #-}
      pokeProductions c_ccat (c_prods `plusPtr` ((8))) 0 (n_prods-1) mk_index prods
{-# LINE 582 "PGF2/Internal.hsc" #-}
      where
        pokeProductions c_ccat ptr top bot mk_index []           = return mk_index
        pokeProductions c_ccat ptr top bot mk_index (prod:prods) = do
          (is_lexical,c_prod) <- newProduction c_ccats funs_ptr c_non_lexical_buf prod pool
          let mk_index' = \concr pool -> do pgf_parser_index concr c_ccat c_prod is_lexical pool
                                            pgf_lzr_index    concr c_ccat c_prod is_lexical pool
                                            mk_index concr pool
          if is_lexical == 0
            then do poke (ptr `plusPtr` (((8))*top)) c_prod
{-# LINE 591 "PGF2/Internal.hsc" #-}
                    pokeProductions c_ccat ptr (top+1) bot mk_index' prods
            else do poke (ptr `plusPtr` (((8))*bot)) c_prod
{-# LINE 593 "PGF2/Internal.hsc" #-}
                    pokeProductions c_ccat ptr top (bot-1) mk_index' prods

    pokeRefDefFunId funs_ptr ptr funid = do
      let c_fun = funs_ptr `plusPtr` (funid * ((32)))
{-# LINE 597 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) c_fun c_abs_lin_fun
{-# LINE 598 "PGF2/Internal.hsc" #-}
      poke ptr c_fun

    pokeCncCat c_ccats ptr (name,start,end,labels) = do
      let n_lins = fromIntegral (length labels) :: CSizeT
      c_cnccat <- gu_malloc_aligned pool
                                    (((24))+n_lins*((8)))
{-# LINE 604 "PGF2/Internal.hsc" #-}
                                    (0)
{-# LINE 605 "PGF2/Internal.hsc" #-}
      case Map.lookup name abscats of
        Just c_abscat -> ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) c_cnccat c_abscat
{-# LINE 607 "PGF2/Internal.hsc" #-}
        Nothing       -> throwIO (PGFError ("The category "++name++" is not in the abstract syntax"))
      c_ccats <- newSequence ((8)) pokeFId [start..end] pool
{-# LINE 609 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) c_cnccat c_ccats
{-# LINE 610 "PGF2/Internal.hsc" #-}
      pokeLabels (c_cnccat `plusPtr` ((24))) labels
{-# LINE 611 "PGF2/Internal.hsc" #-}
      poke ptr c_cnccat
      where
        pokeFId ptr fid = do
          c_ccat <- getCCat c_ccats fid pool
          poke ptr c_ccat

        pokeLabels ptr []     = return []
        pokeLabels ptr (l:ls) = do
          c_l <- newUtf8CString l pool
          poke ptr c_l
          pokeLabels (ptr `plusPtr` ((8))) ls
{-# LINE 622 "PGF2/Internal.hsc" #-}


newPGF :: (?builder :: Builder s) => [(String,Literal)] ->
                                     AbsName ->
                                     AbstrInfo ->
                                     [(ConcName,ConcrInfo)] ->
                                     B s PGF
newPGF gflags absname (AbstrInfo c_aflags c_cats _ c_funs _ c_abs_lin_fun _ _) concrs =
  unsafePerformIO $ do
    ptr <- gu_malloc_aligned pool
                             ((80))
{-# LINE 633 "PGF2/Internal.hsc" #-}
                             (8)
{-# LINE 634 "PGF2/Internal.hsc" #-}
    c_gflags  <- newFlags gflags pool
    c_absname <- newUtf8CString absname pool
    let c_abstr = ptr `plusPtr` ((16))
{-# LINE 637 "PGF2/Internal.hsc" #-}
    c_concrs  <- newSequence ((104)) (pokeConcr c_abstr) concrs pool
{-# LINE 638 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0))   ptr (2 :: (Word16))
{-# LINE 639 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2))   ptr (0 :: (Word16))
{-# LINE 640 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8))          ptr c_gflags
{-# LINE 641 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16))   ptr c_absname
{-# LINE 642 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr c_aflags
{-# LINE 643 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 32))   ptr c_funs
{-# LINE 644 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 40))   ptr c_cats
{-# LINE 645 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ptr c_abs_lin_fun
{-# LINE 646 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 64))       ptr c_concrs
{-# LINE 647 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 72))            ptr pool
{-# LINE 648 "PGF2/Internal.hsc" #-}
    return (B (PGF ptr touch))
  where
    (Builder pool touch) = ?builder

    pokeConcr c_abstr ptr (name, ConcrInfo c_cflags c_printnames c_ccats c_cncfuns c_seqs c_cnccats mk_index c_total_cats) = do
      c_name <- newUtf8CString name pool
      c_fun_indices <- gu_make_map ((8)) gu_string_hasher
{-# LINE 655 "PGF2/Internal.hsc" #-}
                                   ((8)) gu_null_struct
{-# LINE 656 "PGF2/Internal.hsc" #-}
                                   (11)
{-# LINE 657 "PGF2/Internal.hsc" #-}
                                   pool
      c_coerce_idx  <- gu_make_map ((8)) gu_addr_hasher
{-# LINE 659 "PGF2/Internal.hsc" #-}
                                   ((8)) gu_null_struct
{-# LINE 660 "PGF2/Internal.hsc" #-}
                                   (11)
{-# LINE 661 "PGF2/Internal.hsc" #-}
                                   pool
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0))        ptr c_name
{-# LINE 663 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8))       ptr c_abstr
{-# LINE 664 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 16))      ptr c_cflags
{-# LINE 665 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 24))  ptr c_printnames
{-# LINE 666 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 32))       ptr c_ccats
{-# LINE 667 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr c_fun_indices
{-# LINE 668 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 48))  ptr c_coerce_idx
{-# LINE 669 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 56))     ptr c_cncfuns
{-# LINE 670 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 64))   ptr c_seqs
{-# LINE 671 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 72))     ptr c_cnccats
{-# LINE 672 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 80))  ptr c_total_cats
{-# LINE 673 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 88))        ptr nullPtr
{-# LINE 674 "PGF2/Internal.hsc" #-}
      mk_index ptr pool


newFlags :: [(String,Literal)] -> Ptr GuPool -> IO (Ptr GuSeq)
newFlags flags pool = newSequence ((16)) pokeFlag (sortByFst flags) pool
{-# LINE 679 "PGF2/Internal.hsc" #-}
  where
    pokeFlag c_flag (name,value) = do
      c_name  <- newUtf8CString name pool
      c_value <- newLiteral value pool
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0))  c_flag c_name
{-# LINE 684 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) c_flag c_value
{-# LINE 685 "PGF2/Internal.hsc" #-}


newLiteral :: Literal -> Ptr GuPool -> IO GuVariant
newLiteral (LStr val) pool =
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (0)
{-# LINE 691 "PGF2/Internal.hsc" #-}
                            (fromIntegral (((0))+utf8Length val))
{-# LINE 692 "PGF2/Internal.hsc" #-}
                            (0)
{-# LINE 693 "PGF2/Internal.hsc" #-}
                            pptr pool
    pokeUtf8CString val (ptr `plusPtr` ((0)))
{-# LINE 695 "PGF2/Internal.hsc" #-}
    peek pptr
newLiteral (LInt val) pool =
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (1)
{-# LINE 699 "PGF2/Internal.hsc" #-}
                            (fromIntegral ((4)))
{-# LINE 700 "PGF2/Internal.hsc" #-}
                            (4)
{-# LINE 701 "PGF2/Internal.hsc" #-}
                            pptr pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (fromIntegral val :: CInt)
{-# LINE 703 "PGF2/Internal.hsc" #-}
    peek pptr
newLiteral (LFlt val) pool =
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (2)
{-# LINE 707 "PGF2/Internal.hsc" #-}
                            (fromIntegral ((8)))
{-# LINE 708 "PGF2/Internal.hsc" #-}
                            (8)
{-# LINE 709 "PGF2/Internal.hsc" #-}
                            pptr pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (realToFrac val :: CDouble)
{-# LINE 711 "PGF2/Internal.hsc" #-}
    peek pptr


newProduction :: Ptr GuMap -> Ptr PgfCncFun -> Ptr GuBuf -> Production -> Ptr GuPool -> IO ((Word8), GuVariant)
{-# LINE 715 "PGF2/Internal.hsc" #-}
newProduction c_ccats funs_ptr c_non_lexical_buf (PApply fun_id args) pool =
  alloca $ \pptr -> do
    let c_fun = funs_ptr `plusPtr` (fun_id * ((32)))
{-# LINE 718 "PGF2/Internal.hsc" #-}
    c_args <- newSequence ((16)) pokePArg args pool
{-# LINE 719 "PGF2/Internal.hsc" #-}
    ptr <- gu_alloc_variant (0)
{-# LINE 720 "PGF2/Internal.hsc" #-}
                            (fromIntegral ((16)))
{-# LINE 721 "PGF2/Internal.hsc" #-}
                            (8)
{-# LINE 722 "PGF2/Internal.hsc" #-}
                            pptr pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0))  ptr c_fun
{-# LINE 724 "PGF2/Internal.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr c_args
{-# LINE 725 "PGF2/Internal.hsc" #-}
    is_lexical <- pgf_production_is_lexical ptr c_non_lexical_buf pool
    c_prod <- peek pptr
    return (is_lexical,c_prod)
  where
    pokePArg ptr (PArg hypos ccat) = do
      c_ccat <- getCCat c_ccats ccat pool
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr c_ccat
{-# LINE 732 "PGF2/Internal.hsc" #-}
      c_hypos <- newSequence ((8)) pokeCCat hypos pool
{-# LINE 733 "PGF2/Internal.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr c_hypos
{-# LINE 734 "PGF2/Internal.hsc" #-}

    pokeCCat ptr ccat = do
      c_ccat <- getCCat c_ccats ccat pool
      poke ptr c_ccat

newProduction c_ccats funs_ptr c_non_lexical_buf (PCoerce fid) pool =
  alloca $ \pptr -> do
    ptr <- gu_alloc_variant (1)
{-# LINE 742 "PGF2/Internal.hsc" #-}
                            (fromIntegral ((8)))
{-# LINE 743 "PGF2/Internal.hsc" #-}
                            (8)
{-# LINE 744 "PGF2/Internal.hsc" #-}
                            pptr pool
    c_ccat <- getCCat c_ccats fid pool
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr c_ccat
{-# LINE 747 "PGF2/Internal.hsc" #-}
    c_prod <- peek pptr
    return (0,c_prod)


newCncFun absfuns seqs_ptr (funid,(fun,seqids)) pool =
  do let c_absfun = fromMaybe nullPtr (Map.lookup fun absfuns)
         c_ep     = if c_absfun == nullPtr
                      then nullPtr
                      else c_absfun `plusPtr` ((32))
{-# LINE 756 "PGF2/Internal.hsc" #-}
         n_lins   = fromIntegral (length seqids) :: CSizeT
     ptr <- gu_malloc_aligned pool
                              (((32))+n_lins*((8)))
{-# LINE 759 "PGF2/Internal.hsc" #-}
                              (0)
{-# LINE 760 "PGF2/Internal.hsc" #-}
     ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr c_absfun
{-# LINE 761 "PGF2/Internal.hsc" #-}
     ((\hsc_ptr -> pokeByteOff hsc_ptr 8))     ptr c_ep
{-# LINE 762 "PGF2/Internal.hsc" #-}
     ((\hsc_ptr -> pokeByteOff hsc_ptr 16))  ptr (funid :: CInt)
{-# LINE 763 "PGF2/Internal.hsc" #-}
     ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr n_lins
{-# LINE 764 "PGF2/Internal.hsc" #-}
     pokeSequences seqs_ptr (ptr `plusPtr` ((32))) seqids
{-# LINE 765 "PGF2/Internal.hsc" #-}
     return ptr
  where
    pokeSequences seqs_ptr ptr []             = return ()
    pokeSequences seqs_ptr ptr (seqid:seqids) = do
      poke ptr (seqs_ptr `plusPtr` (seqid * ((16))))
{-# LINE 770 "PGF2/Internal.hsc" #-}
      pokeSequences seqs_ptr (ptr `plusPtr` ((8))) seqids
{-# LINE 771 "PGF2/Internal.hsc" #-}

getCCat c_ccats fid pool =
  alloca $ \pfid -> do
    poke pfid (fromIntegral fid :: CInt)
    ptr <- gu_map_find_default c_ccats pfid
    c_ccat <- peek ptr
    if c_ccat /= nullPtr
      then return c_ccat
      else do c_ccat <- gu_malloc_aligned pool
                                          ((72))
{-# LINE 781 "PGF2/Internal.hsc" #-}
                                          (8)
{-# LINE 782 "PGF2/Internal.hsc" #-}
              ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) c_ccat nullPtr
{-# LINE 783 "PGF2/Internal.hsc" #-}
              ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) c_ccat nullPtr
{-# LINE 784 "PGF2/Internal.hsc" #-}
              ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) c_ccat nullPtr
{-# LINE 785 "PGF2/Internal.hsc" #-}
              ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) c_ccat (0 :: CSizeT)
{-# LINE 786 "PGF2/Internal.hsc" #-}
              ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) c_ccat nullPtr
{-# LINE 787 "PGF2/Internal.hsc" #-}
              ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) c_ccat (0 :: CFloat)
{-# LINE 788 "PGF2/Internal.hsc" #-}
              ((\hsc_ptr -> pokeByteOff hsc_ptr 44)) c_ccat fid
{-# LINE 789 "PGF2/Internal.hsc" #-}
              ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) c_ccat nullPtr
{-# LINE 790 "PGF2/Internal.hsc" #-}
              ((\hsc_ptr -> pokeByteOff hsc_ptr 64)) c_ccat nullPtr
{-# LINE 791 "PGF2/Internal.hsc" #-}
              ptr <- gu_map_insert c_ccats pfid
              poke ptr c_ccat
              return c_ccat

newSymbol :: Symbol -> Ptr GuPool -> IO GuVariant
newSymbol (SymCat d r)     pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (0)
{-# LINE 798 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral ((8)))
{-# LINE 799 "PGF2/Internal.hsc" #-}
                                                            (4)
{-# LINE 800 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (fromIntegral d :: CInt)
{-# LINE 802 "PGF2/Internal.hsc" #-}
                                    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (fromIntegral r :: CInt)
{-# LINE 803 "PGF2/Internal.hsc" #-}
                                    peek pptr
newSymbol (SymLit d r)     pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (1)
{-# LINE 806 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral ((8)))
{-# LINE 807 "PGF2/Internal.hsc" #-}
                                                            (4)
{-# LINE 808 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (fromIntegral d :: CInt)
{-# LINE 810 "PGF2/Internal.hsc" #-}
                                    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (fromIntegral r :: CInt)
{-# LINE 811 "PGF2/Internal.hsc" #-}
                                    peek pptr
newSymbol (SymVar d r)     pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (2)
{-# LINE 814 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral ((8)))
{-# LINE 815 "PGF2/Internal.hsc" #-}
                                                            (4)
{-# LINE 816 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (fromIntegral d :: CInt)
{-# LINE 818 "PGF2/Internal.hsc" #-}
                                    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (fromIntegral r :: CInt)
{-# LINE 819 "PGF2/Internal.hsc" #-}
                                    peek pptr
newSymbol (SymKS t)        pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (3)
{-# LINE 822 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral (((0))+utf8Length t))
{-# LINE 823 "PGF2/Internal.hsc" #-}
                                                            (0)
{-# LINE 824 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    pokeUtf8CString t (ptr `plusPtr` ((0)))
{-# LINE 826 "PGF2/Internal.hsc" #-}
                                    peek pptr
newSymbol (SymKP def alts) pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (4)
{-# LINE 829 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral (((16))+(length alts * ((16)))))
{-# LINE 830 "PGF2/Internal.hsc" #-}
                                                            (0)
{-# LINE 831 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    c_def <- newSymbols def pool
                                    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr c_def
{-# LINE 834 "PGF2/Internal.hsc" #-}
                                    pokeAlternatives (ptr `plusPtr` ((16))) alts pool
{-# LINE 835 "PGF2/Internal.hsc" #-}
                                    peek pptr
newSymbol SymBIND          pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (5)
{-# LINE 838 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral ((0)))
{-# LINE 839 "PGF2/Internal.hsc" #-}
                                                            (1)
{-# LINE 840 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    peek pptr
newSymbol SymNE            pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (7)
{-# LINE 844 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral ((0)))
{-# LINE 845 "PGF2/Internal.hsc" #-}
                                                            (1)
{-# LINE 846 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    peek pptr
newSymbol SymSOFT_BIND     pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (6)
{-# LINE 850 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral ((0)))
{-# LINE 851 "PGF2/Internal.hsc" #-}
                                                            (1)
{-# LINE 852 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    peek pptr
newSymbol SymSOFT_SPACE    pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (8)
{-# LINE 856 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral ((0)))
{-# LINE 857 "PGF2/Internal.hsc" #-}
                                                            (1)
{-# LINE 858 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    peek pptr
newSymbol SymCAPIT         pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (9)
{-# LINE 862 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral ((0)))
{-# LINE 863 "PGF2/Internal.hsc" #-}
                                                            (1)
{-# LINE 864 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    peek pptr
newSymbol SymALL_CAPIT     pool = alloca $ \pptr -> do
                                    ptr <- gu_alloc_variant (10)
{-# LINE 868 "PGF2/Internal.hsc" #-}
                                                            (fromIntegral ((0)))
{-# LINE 869 "PGF2/Internal.hsc" #-}
                                                            (1)
{-# LINE 870 "PGF2/Internal.hsc" #-}
                                                            pptr pool
                                    peek pptr

newSymbols syms pool = newSequence ((8)) pokeSymbol syms pool
{-# LINE 874 "PGF2/Internal.hsc" #-}
  where
    pokeSymbol p_sym sym = do
      c_sym <- newSymbol sym pool
      poke p_sym c_sym

pokeAlternatives ptr []                     pool = return ()
pokeAlternatives ptr ((syms,prefixes):alts) pool = do
  c_syms     <- newSymbols syms pool
  c_prefixes <- newSequence ((8)) (pokeString pool) prefixes pool
{-# LINE 883 "PGF2/Internal.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 0))     ptr c_syms
{-# LINE 884 "PGF2/Internal.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr c_prefixes
{-# LINE 885 "PGF2/Internal.hsc" #-}
  pokeAlternatives (ptr `plusPtr` ((16))) alts pool
{-# LINE 886 "PGF2/Internal.hsc" #-}

pokeString pool c_elem str = do
  c_str <- newUtf8CString str pool
  poke c_elem c_str

newMap key_size hasher newKey elem_size pokeElem values pool = do
  map <- gu_make_map key_size hasher
                     elem_size gu_null_struct
                     (11)
{-# LINE 895 "PGF2/Internal.hsc" #-}
                     pool
  insert map values pool
  return map
  where
    insert map []                  pool = return ()
    insert map ((key,elem):values) pool = do
      c_key  <- newKey key pool
      c_elem <- gu_map_insert map c_key
      pokeElem c_elem elem
      insert map values pool


writePGF :: FilePath -> PGF -> IO ()
writePGF fpath p = do
  pool <- gu_new_pool
  exn <- gu_new_exn pool
  withCString fpath $ \c_fpath ->
    pgf_write (pgf p) c_fpath exn
  touchPGF p
  failed <- gu_exn_is_raised exn
  if failed
    then do is_errno <- gu_exn_caught exn gu_exn_type_GuErrno
            if is_errno
              then do perrno <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) exn
{-# LINE 919 "PGF2/Internal.hsc" #-}
                      errno  <- peek perrno
                      gu_pool_free pool
                      ioError (errnoToIOError "writePGF" (Errno errno) Nothing (Just fpath))
              else do gu_pool_free pool
                      throwIO (PGFError "The grammar cannot be stored")
    else do gu_pool_free pool
            return ()

sortByFst  = sortBy (\(x,_)     (y,_)     -> compare x y)
sortByFst3 = sortBy (\(x,_,_)   (y,_,_)   -> compare x y)
sortByFst4 = sortBy (\(x,_,_,_) (y,_,_,_) -> compare x y)