{-# LINE 1 "Bindings/Friso/Raw.hsc" #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LINE 2 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 3 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 4 "Bindings/Friso/Raw.hsc" #-}
module Bindings.Friso.Raw where
import Foreign.Ptr
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 7 "Bindings/Friso/Raw.hsc" #-}

import Bindings.Friso.Raw.FrisoAPI
{- typedef enum {
            __LEX_CJK_WORDS__ = 0,
            __LEX_CJK_UNITS__ = 1,
            __LEX_ECM_WORDS__ = 2,
            __LEX_CEM_WORDS__ = 3,
            __LEX_CN_LNAME__ = 4,
            __LEX_CN_SNAME__ = 5,
            __LEX_CN_DNAME1__ = 6,
            __LEX_CN_DNAME2__ = 7,
            __LEX_CN_LNA__ = 8,
            __LEX_STOPWORDS__ = 9,
            __LEX_ENPUN_WORDS__ = 10,
            __LEX_EN_WORDS__ = 11,
            __LEX_OTHER_WORDS__ = 15,
            __LEX_NCSYN_WORDS__ = 16,
            __LEX_PUNC_WORDS__ = 17,
            __LEX_UNKNOW_WORDS__ = 18
        } friso_lex_t; -}
type C'friso_lex_t = CUInt

{-# LINE 28 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_CJK_WORDS__ = 0
c'__LEX_CJK_WORDS__ :: (Num a) => a

{-# LINE 29 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_CJK_UNITS__ = 1
c'__LEX_CJK_UNITS__ :: (Num a) => a

{-# LINE 30 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_ECM_WORDS__ = 2
c'__LEX_ECM_WORDS__ :: (Num a) => a

{-# LINE 31 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_CEM_WORDS__ = 3
c'__LEX_CEM_WORDS__ :: (Num a) => a

{-# LINE 32 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_CN_LNAME__ = 4
c'__LEX_CN_LNAME__ :: (Num a) => a

{-# LINE 33 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_CN_SNAME__ = 5
c'__LEX_CN_SNAME__ :: (Num a) => a

{-# LINE 34 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_CN_DNAME1__ = 6
c'__LEX_CN_DNAME1__ :: (Num a) => a

{-# LINE 35 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_CN_DNAME2__ = 7
c'__LEX_CN_DNAME2__ :: (Num a) => a

{-# LINE 36 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_CN_LNA__ = 8
c'__LEX_CN_LNA__ :: (Num a) => a

{-# LINE 37 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_STOPWORDS__ = 9
c'__LEX_STOPWORDS__ :: (Num a) => a

{-# LINE 38 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_ENPUN_WORDS__ = 10
c'__LEX_ENPUN_WORDS__ :: (Num a) => a

{-# LINE 39 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_EN_WORDS__ = 11
c'__LEX_EN_WORDS__ :: (Num a) => a

{-# LINE 40 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_OTHER_WORDS__ = 15
c'__LEX_OTHER_WORDS__ :: (Num a) => a

{-# LINE 41 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_NCSYN_WORDS__ = 16
c'__LEX_NCSYN_WORDS__ :: (Num a) => a

{-# LINE 42 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_PUNC_WORDS__ = 17
c'__LEX_PUNC_WORDS__ :: (Num a) => a

{-# LINE 43 "Bindings/Friso/Raw.hsc" #-}
c'__LEX_UNKNOW_WORDS__ = 18
c'__LEX_UNKNOW_WORDS__ :: (Num a) => a

{-# LINE 44 "Bindings/Friso/Raw.hsc" #-}
{- typedef friso_hash_t * friso_dic_t; -}
type C'friso_dic_t = C'friso_hash_cdt

{-# LINE 46 "Bindings/Friso/Raw.hsc" #-}
{- typedef struct {
            uchar_t length;
            uchar_t rlen;
            uchar_t type;
            uchar_t ctrlMask;
            uint_t offset;
            fstring word;
            friso_array_t syn;
            friso_array_t pos;
            uint_t fre;
        } lex_entry_cdt; -}

{-# LINE 58 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 59 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 60 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 61 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 62 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 63 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 64 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 65 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 66 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 67 "Bindings/Friso/Raw.hsc" #-}
data C'lex_entry_cdt = C'lex_entry_cdt{
  c'lex_entry_cdt'length :: CUChar,
  c'lex_entry_cdt'rlen :: CUChar,
  c'lex_entry_cdt'type :: CUChar,
  c'lex_entry_cdt'ctrlMask :: CUChar,
  c'lex_entry_cdt'offset :: CUInt,
  c'lex_entry_cdt'word :: CString,
  c'lex_entry_cdt'syn :: C'friso_array_entry,
  c'lex_entry_cdt'pos :: C'friso_array_entry,
  c'lex_entry_cdt'fre :: CUInt
} deriving (Eq,Show)
p'lex_entry_cdt'length p = plusPtr p 0
p'lex_entry_cdt'length :: Ptr (C'lex_entry_cdt) -> Ptr (CUChar)
p'lex_entry_cdt'rlen p = plusPtr p 1
p'lex_entry_cdt'rlen :: Ptr (C'lex_entry_cdt) -> Ptr (CUChar)
p'lex_entry_cdt'type p = plusPtr p 2
p'lex_entry_cdt'type :: Ptr (C'lex_entry_cdt) -> Ptr (CUChar)
p'lex_entry_cdt'ctrlMask p = plusPtr p 3
p'lex_entry_cdt'ctrlMask :: Ptr (C'lex_entry_cdt) -> Ptr (CUChar)
p'lex_entry_cdt'offset p = plusPtr p 4
p'lex_entry_cdt'offset :: Ptr (C'lex_entry_cdt) -> Ptr (CUInt)
p'lex_entry_cdt'word p = plusPtr p 8
p'lex_entry_cdt'word :: Ptr (C'lex_entry_cdt) -> Ptr (CString)
p'lex_entry_cdt'syn p = plusPtr p 16
p'lex_entry_cdt'syn :: Ptr (C'lex_entry_cdt) -> Ptr (C'friso_array_entry)
p'lex_entry_cdt'pos p = plusPtr p 24
p'lex_entry_cdt'pos :: Ptr (C'lex_entry_cdt) -> Ptr (C'friso_array_entry)
p'lex_entry_cdt'fre p = plusPtr p 32
p'lex_entry_cdt'fre :: Ptr (C'lex_entry_cdt) -> Ptr (CUInt)
instance Storable C'lex_entry_cdt where
  sizeOf _ = 40
  alignment _ = 8
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 1
    v2 <- peekByteOff p 2
    v3 <- peekByteOff p 3
    v4 <- peekByteOff p 4
    v5 <- peekByteOff p 8
    v6 <- peekByteOff p 16
    v7 <- peekByteOff p 24
    v8 <- peekByteOff p 32
    return $ C'lex_entry_cdt v0 v1 v2 v3 v4 v5 v6 v7 v8
  poke p (C'lex_entry_cdt v0 v1 v2 v3 v4 v5 v6 v7 v8) = do
    pokeByteOff p 0 v0
    pokeByteOff p 1 v1
    pokeByteOff p 2 v2
    pokeByteOff p 3 v3
    pokeByteOff p 4 v4
    pokeByteOff p 8 v5
    pokeByteOff p 16 v6
    pokeByteOff p 24 v7
    pokeByteOff p 32 v8
    return ()

{-# LINE 68 "Bindings/Friso/Raw.hsc" #-}
{- typedef lex_entry_cdt * lex_entry_t; -}
type C'lex_entry_t = C'lex_entry_cdt

{-# LINE 70 "Bindings/Friso/Raw.hsc" #-}
{- typedef enum {
            FRISO_UTF8 = 0, FRISO_GBK = 1
        } friso_charset_t; -}
type C'friso_charset_t = CUInt

{-# LINE 74 "Bindings/Friso/Raw.hsc" #-}
c'FRISO_UTF8 = 0
c'FRISO_UTF8 :: (Num a) => a

{-# LINE 75 "Bindings/Friso/Raw.hsc" #-}
c'FRISO_GBK = 1
c'FRISO_GBK :: (Num a) => a

{-# LINE 76 "Bindings/Friso/Raw.hsc" #-}
{- typedef struct {
            friso_dic_t dic; friso_charset_t charset;
        } friso_entry; -}

{-# LINE 80 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 81 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 82 "Bindings/Friso/Raw.hsc" #-}
data C'friso_entry = C'friso_entry{
  c'friso_entry'dic :: C'friso_hash_cdt,
  c'friso_entry'charset :: C'friso_charset_t
} deriving (Eq,Show)
p'friso_entry'dic p = plusPtr p 0
p'friso_entry'dic :: Ptr (C'friso_entry) -> Ptr (C'friso_hash_cdt)
p'friso_entry'charset p = plusPtr p 8
p'friso_entry'charset :: Ptr (C'friso_entry) -> Ptr (C'friso_charset_t)
instance Storable C'friso_entry where
  sizeOf _ = 16
  alignment _ = 8
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 8
    return $ C'friso_entry v0 v1
  poke p (C'friso_entry v0 v1) = do
    pokeByteOff p 0 v0
    pokeByteOff p 8 v1
    return ()

{-# LINE 83 "Bindings/Friso/Raw.hsc" #-}
{- typedef friso_entry * friso_t; -}
type C'friso_t = C'friso_entry

{-# LINE 85 "Bindings/Friso/Raw.hsc" #-}
{- typedef enum {
            __FRISO_SIMPLE_MODE__ = 1, __FRISO_COMPLEX_MODE__ = 2
        } friso_mode_t; -}
type C'friso_mode_t = CUInt

{-# LINE 89 "Bindings/Friso/Raw.hsc" #-}
c'__FRISO_SIMPLE_MODE__ = 1
c'__FRISO_SIMPLE_MODE__ :: (Num a) => a

{-# LINE 90 "Bindings/Friso/Raw.hsc" #-}
c'__FRISO_COMPLEX_MODE__ = 2
c'__FRISO_COMPLEX_MODE__ :: (Num a) => a

{-# LINE 91 "Bindings/Friso/Raw.hsc" #-}
{- typedef struct {
            ushort_t max_len;
            ushort_t r_name;
            ushort_t mix_len;
            ushort_t lna_len;
            ushort_t add_syn;
            ushort_t clr_stw;
            ushort_t keep_urec;
            ushort_t spx_out;
            ushort_t en_sseg;
            ushort_t st_minl;
            uint_t nthreshold;
            friso_mode_t mode;
            char kpuncs[13];
        } friso_config_entry; -}

{-# LINE 107 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 108 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 109 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 110 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 111 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 112 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 113 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 114 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 115 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 116 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 117 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 118 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 119 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 120 "Bindings/Friso/Raw.hsc" #-}
data C'friso_config_entry = C'friso_config_entry{
  c'friso_config_entry'max_len :: CUShort,
  c'friso_config_entry'r_name :: CUShort,
  c'friso_config_entry'mix_len :: CUShort,
  c'friso_config_entry'lna_len :: CUShort,
  c'friso_config_entry'add_syn :: CUShort,
  c'friso_config_entry'clr_stw :: CUShort,
  c'friso_config_entry'keep_urec :: CUShort,
  c'friso_config_entry'spx_out :: CUShort,
  c'friso_config_entry'en_sseg :: CUShort,
  c'friso_config_entry'st_minl :: CUShort,
  c'friso_config_entry'nthreshold :: CUInt,
  c'friso_config_entry'mode :: C'friso_mode_t,
  c'friso_config_entry'kpuncs :: [CString]
} deriving (Eq,Show)
p'friso_config_entry'max_len p = plusPtr p 0
p'friso_config_entry'max_len :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'r_name p = plusPtr p 2
p'friso_config_entry'r_name :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'mix_len p = plusPtr p 4
p'friso_config_entry'mix_len :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'lna_len p = plusPtr p 6
p'friso_config_entry'lna_len :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'add_syn p = plusPtr p 8
p'friso_config_entry'add_syn :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'clr_stw p = plusPtr p 10
p'friso_config_entry'clr_stw :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'keep_urec p = plusPtr p 12
p'friso_config_entry'keep_urec :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'spx_out p = plusPtr p 14
p'friso_config_entry'spx_out :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'en_sseg p = plusPtr p 16
p'friso_config_entry'en_sseg :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'st_minl p = plusPtr p 18
p'friso_config_entry'st_minl :: Ptr (C'friso_config_entry) -> Ptr (CUShort)
p'friso_config_entry'nthreshold p = plusPtr p 20
p'friso_config_entry'nthreshold :: Ptr (C'friso_config_entry) -> Ptr (CUInt)
p'friso_config_entry'mode p = plusPtr p 24
p'friso_config_entry'mode :: Ptr (C'friso_config_entry) -> Ptr (C'friso_mode_t)
p'friso_config_entry'kpuncs p = plusPtr p 28
p'friso_config_entry'kpuncs :: Ptr (C'friso_config_entry) -> Ptr (CString)
instance Storable C'friso_config_entry where
  sizeOf _ = 44
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 2
    v2 <- peekByteOff p 4
    v3 <- peekByteOff p 6
    v4 <- peekByteOff p 8
    v5 <- peekByteOff p 10
    v6 <- peekByteOff p 12
    v7 <- peekByteOff p 14
    v8 <- peekByteOff p 16
    v9 <- peekByteOff p 18
    v10 <- peekByteOff p 20
    v11 <- peekByteOff p 24
    v12 <- let s = div 13 $ sizeOf $ (undefined :: CString) in peekArray s (plusPtr p 28)
    return $ C'friso_config_entry v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12
  poke p (C'friso_config_entry v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12) = do
    pokeByteOff p 0 v0
    pokeByteOff p 2 v1
    pokeByteOff p 4 v2
    pokeByteOff p 6 v3
    pokeByteOff p 8 v4
    pokeByteOff p 10 v5
    pokeByteOff p 12 v6
    pokeByteOff p 14 v7
    pokeByteOff p 16 v8
    pokeByteOff p 18 v9
    pokeByteOff p 20 v10
    pokeByteOff p 24 v11
    let s = div 13 $ sizeOf $ (undefined :: CString)
    pokeArray (plusPtr p 28) (take s v12)
    return ()

{-# LINE 121 "Bindings/Friso/Raw.hsc" #-}
{- typedef friso_config_entry * friso_config_t; -}
type C'friso_config_t = C'friso_config_entry

{-# LINE 123 "Bindings/Friso/Raw.hsc" #-}
{- typedef struct {
            uchar_t type;
            uchar_t length;
            uchar_t rlen;
            char pos;
            int offset;
            char word[128];
        } friso_hits_entry; -}

{-# LINE 132 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 133 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 134 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 135 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 136 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 137 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 138 "Bindings/Friso/Raw.hsc" #-}
data C'friso_hits_entry = C'friso_hits_entry{
  c'friso_hits_entry'type :: CUChar,
  c'friso_hits_entry'length :: CUChar,
  c'friso_hits_entry'rlen :: CUChar,
  c'friso_hits_entry'pos :: CString,
  c'friso_hits_entry'offset :: CInt,
  c'friso_hits_entry'word :: [CString]
} deriving (Eq,Show)
p'friso_hits_entry'type p = plusPtr p 0
p'friso_hits_entry'type :: Ptr (C'friso_hits_entry) -> Ptr (CUChar)
p'friso_hits_entry'length p = plusPtr p 1
p'friso_hits_entry'length :: Ptr (C'friso_hits_entry) -> Ptr (CUChar)
p'friso_hits_entry'rlen p = plusPtr p 2
p'friso_hits_entry'rlen :: Ptr (C'friso_hits_entry) -> Ptr (CUChar)
p'friso_hits_entry'pos p = plusPtr p 3
p'friso_hits_entry'pos :: Ptr (C'friso_hits_entry) -> Ptr (CString)
p'friso_hits_entry'offset p = plusPtr p 4
p'friso_hits_entry'offset :: Ptr (C'friso_hits_entry) -> Ptr (CInt)
p'friso_hits_entry'word p = plusPtr p 8
p'friso_hits_entry'word :: Ptr (C'friso_hits_entry) -> Ptr (CString)
instance Storable C'friso_hits_entry where
  sizeOf _ = 136
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 1
    v2 <- peekByteOff p 2
    v3 <- peekByteOff p 3
    v4 <- peekByteOff p 4
    v5 <- let s = div 128 $ sizeOf $ (undefined :: CString) in peekArray s (plusPtr p 8)
    return $ C'friso_hits_entry v0 v1 v2 v3 v4 v5
  poke p (C'friso_hits_entry v0 v1 v2 v3 v4 v5) = do
    pokeByteOff p 0 v0
    pokeByteOff p 1 v1
    pokeByteOff p 2 v2
    pokeByteOff p 3 v3
    pokeByteOff p 4 v4
    let s = div 128 $ sizeOf $ (undefined :: CString)
    pokeArray (plusPtr p 8) (take s v5)
    return ()

{-# LINE 139 "Bindings/Friso/Raw.hsc" #-}
{- typedef friso_hits_entry * friso_hits_t; -}
type C'friso_hits_t = C'friso_hits_entry

{-# LINE 141 "Bindings/Friso/Raw.hsc" #-}
{- typedef struct {
            fstring text;
            uint_t idx;
            uint_t length;
            uint_t bytes;
            uint_t unicode;
            uint_t ctrlMask;
            friso_link_t pool;
            string_buffer_t sbuf;
            friso_hits_t hits;
            char buffer[7];
        } friso_task_entry; -}

{-# LINE 154 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 155 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 156 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 157 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 158 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 159 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 160 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 161 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 162 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 163 "Bindings/Friso/Raw.hsc" #-}

{-# LINE 164 "Bindings/Friso/Raw.hsc" #-}
data C'friso_task_entry = C'friso_task_entry{
  c'friso_task_entry'text :: CString,
  c'friso_task_entry'idx :: CUInt,
  c'friso_task_entry'length :: CUInt,
  c'friso_task_entry'bytes :: CUInt,
  c'friso_task_entry'unicode :: CUInt,
  c'friso_task_entry'ctrlMask :: CUInt,
  c'friso_task_entry'pool :: C'friso_link_entry,
  c'friso_task_entry'sbuf :: C'string_buffer_entry,
  c'friso_task_entry'hits :: C'friso_hits_entry,
  c'friso_task_entry'buffer :: [CString]
} deriving (Eq,Show)
p'friso_task_entry'text p = plusPtr p 0
p'friso_task_entry'text :: Ptr (C'friso_task_entry) -> Ptr (CString)
p'friso_task_entry'idx p = plusPtr p 8
p'friso_task_entry'idx :: Ptr (C'friso_task_entry) -> Ptr (CUInt)
p'friso_task_entry'length p = plusPtr p 12
p'friso_task_entry'length :: Ptr (C'friso_task_entry) -> Ptr (CUInt)
p'friso_task_entry'bytes p = plusPtr p 16
p'friso_task_entry'bytes :: Ptr (C'friso_task_entry) -> Ptr (CUInt)
p'friso_task_entry'unicode p = plusPtr p 20
p'friso_task_entry'unicode :: Ptr (C'friso_task_entry) -> Ptr (CUInt)
p'friso_task_entry'ctrlMask p = plusPtr p 24
p'friso_task_entry'ctrlMask :: Ptr (C'friso_task_entry) -> Ptr (CUInt)
p'friso_task_entry'pool p = plusPtr p 32
p'friso_task_entry'pool :: Ptr (C'friso_task_entry) -> Ptr (C'friso_link_entry)
p'friso_task_entry'sbuf p = plusPtr p 40
p'friso_task_entry'sbuf :: Ptr (C'friso_task_entry) -> Ptr (C'string_buffer_entry)
p'friso_task_entry'hits p = plusPtr p 48
p'friso_task_entry'hits :: Ptr (C'friso_task_entry) -> Ptr (C'friso_hits_entry)
p'friso_task_entry'buffer p = plusPtr p 56
p'friso_task_entry'buffer :: Ptr (C'friso_task_entry) -> Ptr (CString)
instance Storable C'friso_task_entry where
  sizeOf _ = 64
  alignment _ = 8
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 8
    v2 <- peekByteOff p 12
    v3 <- peekByteOff p 16
    v4 <- peekByteOff p 20
    v5 <- peekByteOff p 24
    v6 <- peekByteOff p 32
    v7 <- peekByteOff p 40
    v8 <- peekByteOff p 48
    v9 <- let s = div 7 $ sizeOf $ (undefined :: CString) in peekArray s (plusPtr p 56)
    return $ C'friso_task_entry v0 v1 v2 v3 v4 v5 v6 v7 v8 v9
  poke p (C'friso_task_entry v0 v1 v2 v3 v4 v5 v6 v7 v8 v9) = do
    pokeByteOff p 0 v0
    pokeByteOff p 8 v1
    pokeByteOff p 12 v2
    pokeByteOff p 16 v3
    pokeByteOff p 20 v4
    pokeByteOff p 24 v5
    pokeByteOff p 32 v6
    pokeByteOff p 40 v7
    pokeByteOff p 48 v8
    let s = div 7 $ sizeOf $ (undefined :: CString)
    pokeArray (plusPtr p 56) (take s v9)
    return ()

{-# LINE 165 "Bindings/Friso/Raw.hsc" #-}
{- typedef friso_task_entry * friso_task_t; -}
type C'friso_task_t = C'friso_task_entry

{-# LINE 167 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_new" c'friso_new
  :: IO (Ptr C'friso_entry)
foreign import ccall "&friso_new" p'friso_new
  :: FunPtr (IO (Ptr C'friso_entry))

{-# LINE 168 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_init_from_ifile" c'friso_init_from_ifile
  :: Ptr C'friso_entry -> Ptr C'friso_config_entry -> CString -> IO CInt
foreign import ccall "&friso_init_from_ifile" p'friso_init_from_ifile
  :: FunPtr (Ptr C'friso_entry -> Ptr C'friso_config_entry -> CString -> IO CInt)

{-# LINE 169 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_free" c'friso_free
  :: Ptr C'friso_entry -> IO ()
foreign import ccall "&friso_free" p'friso_free
  :: FunPtr (Ptr C'friso_entry -> IO ())

{-# LINE 170 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_new_config" c'friso_new_config
  :: IO (Ptr C'friso_config_entry)
foreign import ccall "&friso_new_config" p'friso_new_config
  :: FunPtr (IO (Ptr C'friso_config_entry))

{-# LINE 171 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_init_config" c'friso_init_config
  :: Ptr C'friso_config_entry -> IO ()
foreign import ccall "&friso_init_config" p'friso_init_config
  :: FunPtr (Ptr C'friso_config_entry -> IO ())

{-# LINE 172 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_new_task" c'friso_new_task
  :: IO (Ptr C'friso_task_entry)
foreign import ccall "&friso_new_task" p'friso_new_task
  :: FunPtr (IO (Ptr C'friso_task_entry))

{-# LINE 173 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_free_task" c'friso_free_task
  :: Ptr C'friso_task_entry -> IO ()
foreign import ccall "&friso_free_task" p'friso_free_task
  :: FunPtr (Ptr C'friso_task_entry -> IO ())

{-# LINE 174 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_new_hits" c'friso_new_hits
  :: IO (Ptr C'friso_hits_entry)
foreign import ccall "&friso_new_hits" p'friso_new_hits
  :: FunPtr (IO (Ptr C'friso_hits_entry))

{-# LINE 175 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_set_text" c'friso_set_text
  :: Ptr C'friso_task_entry -> CString -> IO ()
foreign import ccall "&friso_set_text" p'friso_set_text
  :: FunPtr (Ptr C'friso_task_entry -> CString -> IO ())

{-# LINE 176 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_next" c'friso_next
  :: Ptr C'friso_entry -> Ptr C'friso_config_entry -> Ptr C'friso_task_entry -> IO (Ptr C'friso_hits_entry)
foreign import ccall "&friso_next" p'friso_next
  :: FunPtr (Ptr C'friso_entry -> Ptr C'friso_config_entry -> Ptr C'friso_task_entry -> IO (Ptr C'friso_hits_entry))

{-# LINE 177 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_dic_new" c'friso_dic_new
  :: IO (Ptr C'friso_hash_cdt)
foreign import ccall "&friso_dic_new" p'friso_dic_new
  :: FunPtr (IO (Ptr C'friso_hash_cdt))

{-# LINE 178 "Bindings/Friso/Raw.hsc" #-}
-- #ccall file_get_line , CString -> Ptr <struct _IO_FILE> -> IO CString
foreign import ccall "friso_dic_free" c'friso_dic_free
  :: Ptr C'friso_hash_cdt -> IO ()
foreign import ccall "&friso_dic_free" p'friso_dic_free
  :: FunPtr (Ptr C'friso_hash_cdt -> IO ())

{-# LINE 180 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "new_lex_entry" c'new_lex_entry
  :: CString -> Ptr C'friso_array_entry -> CUInt -> CUInt -> CUInt -> IO (Ptr C'lex_entry_cdt)
foreign import ccall "&new_lex_entry" p'new_lex_entry
  :: FunPtr (CString -> Ptr C'friso_array_entry -> CUInt -> CUInt -> CUInt -> IO (Ptr C'lex_entry_cdt))

{-# LINE 181 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "free_lex_entry" c'free_lex_entry
  :: Ptr C'lex_entry_cdt -> IO ()
foreign import ccall "&free_lex_entry" p'free_lex_entry
  :: FunPtr (Ptr C'lex_entry_cdt -> IO ())

{-# LINE 182 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_dic_load" c'friso_dic_load
  :: Ptr C'friso_entry -> Ptr C'friso_config_entry -> Ptr C'friso_lex_t -> CString -> CUInt -> IO ()
foreign import ccall "&friso_dic_load" p'friso_dic_load
  :: FunPtr (Ptr C'friso_entry -> Ptr C'friso_config_entry -> Ptr C'friso_lex_t -> CString -> CUInt -> IO ())

{-# LINE 183 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_dic_load_from_ifile" c'friso_dic_load_from_ifile
  :: Ptr C'friso_entry -> Ptr C'friso_config_entry -> CString -> CUInt -> IO ()
foreign import ccall "&friso_dic_load_from_ifile" p'friso_dic_load_from_ifile
  :: FunPtr (Ptr C'friso_entry -> Ptr C'friso_config_entry -> CString -> CUInt -> IO ())

{-# LINE 184 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_dic_add" c'friso_dic_add
  :: Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> CString -> Ptr C'friso_array_entry -> IO ()
foreign import ccall "&friso_dic_add" p'friso_dic_add
  :: FunPtr (Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> CString -> Ptr C'friso_array_entry -> IO ())

{-# LINE 185 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_dic_add_with_fre" c'friso_dic_add_with_fre
  :: Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> CString -> Ptr C'friso_array_entry -> CUInt -> IO ()
foreign import ccall "&friso_dic_add_with_fre" p'friso_dic_add_with_fre
  :: FunPtr (Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> CString -> Ptr C'friso_array_entry -> CUInt -> IO ())

{-# LINE 186 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_dic_match" c'friso_dic_match
  :: Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> CString -> IO CInt
foreign import ccall "&friso_dic_match" p'friso_dic_match
  :: FunPtr (Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> CString -> IO CInt)

{-# LINE 187 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_dic_get" c'friso_dic_get
  :: Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> CString -> IO (Ptr C'lex_entry_cdt)
foreign import ccall "&friso_dic_get" p'friso_dic_get
  :: FunPtr (Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> CString -> IO (Ptr C'lex_entry_cdt))

{-# LINE 188 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_spec_dic_size" c'friso_spec_dic_size
  :: Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> IO CUInt
foreign import ccall "&friso_spec_dic_size" p'friso_spec_dic_size
  :: FunPtr (Ptr C'friso_hash_cdt -> Ptr C'friso_lex_t -> IO CUInt)

{-# LINE 189 "Bindings/Friso/Raw.hsc" #-}
foreign import ccall "friso_all_dic_size" c'friso_all_dic_size
  :: Ptr C'friso_hash_cdt -> IO CUInt
foreign import ccall "&friso_all_dic_size" p'friso_all_dic_size
  :: FunPtr (Ptr C'friso_hash_cdt -> IO CUInt)

{-# LINE 190 "Bindings/Friso/Raw.hsc" #-}