module Ivory.Stdlib.String where
import Data.Char (ord)
import GHC.TypeLits
import Ivory.Language
import qualified Control.Monad as M
gen_stringInit :: (IvoryStruct name, SingI len)
=> Label name (Array len (Stored Uint8))
-> Label name (Stored (Ix len))
-> String
-> Init (Struct name)
gen_stringInit l_data l_len xs =
istruct
[ l_data .= iarray (map (ival . fromIntegral . ord) xs)
, l_len .= ival (toIx len)
]
where
len :: Sint32
len = fromIntegral (length xs)
stringInit :: IvoryString str => String -> Init str
stringInit = gen_stringInit stringDataL stringLengthL
stringCapacity :: forall ref str s.
(IvoryString str, IvoryRef ref)
=> ref s str -> Sint32
stringCapacity _ = len
where
len :: Sint32
len = fromIntegral (fromSing (sing :: Sing (Capacity str)))
stringLength :: ( IvoryString str
, IvoryRef ref
, IvoryExpr (ref s (Stored (Ix (Capacity str))))
, IvoryExpr (ref s str))
=> ref s str -> ref s (Stored (Ix (Capacity str)))
stringLength x = x ~> stringLengthL
stringData :: ( IvoryString str
, IvoryRef ref
, IvoryExpr (ref s (Array (Capacity str) (Stored Uint8)))
, IvoryExpr (ref s (CArray (Stored Uint8)))
, IvoryExpr (ref s str))
=> ref s str -> ref s (CArray (Stored Uint8))
stringData x = toCArray (x ~> stringDataL)
memcmp :: Def ('[ ConstRef s1 (CArray (Stored Uint8))
, ConstRef s2 (CArray (Stored Uint8))
, Sint32] :-> Sint32)
memcmp = importProc "memcmp" "string.h"
memcpy :: Def ('[ Ref s1 (CArray (Stored Uint8))
, ConstRef s2 (CArray (Stored Uint8))
, Sint32] :-> Sint32)
memcpy = importProc "memcpy" "string.h"
istr_len :: IvoryString str
=> ConstRef s str
-> Ivory eff (Ix (Capacity str))
istr_len str = do
len <- deref (stringLength str)
assert (fromIx len <? stringCapacity str)
return len
istr_copy :: IvoryString str
=> Ref s1 str
-> ConstRef s2 str
-> Ivory eff ()
istr_copy dest src = do
len <- istr_len src
call_ memcpy (stringData dest) (stringData src) (fromIx len)
store (stringLength dest) len
istr_convert :: (IvoryString str1, IvoryString str2)
=> Ref s1 str1
-> ConstRef s2 str2
-> Ivory eff IBool
istr_convert = undefined
do_istr_eq :: Def ('[ ConstRef s1 (CArray (Stored Uint8))
, Sint32
, ConstRef s2 (CArray (Stored Uint8))
, Sint32
] :-> IBool)
do_istr_eq = proc "ivory_string_eq" $ \s1 len1 s2 len2 -> body $ do
ifte_ (len1 ==? len2)
(do r <- call memcmp s1 s2 len1
ret (r ==? 0))
(ret false)
istr_eq :: (IvoryString str1, IvoryString str2)
=> ConstRef s1 str1
-> ConstRef s2 str2
-> Ivory eff IBool
istr_eq s1 s2 = do
len1 <- istr_len s1
ptr1 <- assign (stringData s1)
len2 <- istr_len s2
ptr2 <- assign (stringData s2)
call do_istr_eq ptr1 (fromIx len1) ptr2 (fromIx len2)
string_copy :: Def ('[ Ref s1 (CArray (Stored Uint8))
, Sint32
, ConstRef s2 (CArray (Stored Uint8))
, Sint32] :-> Sint32)
string_copy = importProc "ivory_stdlib_string_copy"
"ivory_stdlib_string_prim.h"
string_copy_z :: Def ('[ Ref s1 (CArray (Stored Uint8))
, Sint32
, ConstRef s2 (CArray (Stored Uint8))
, Sint32] :-> Sint32)
string_copy_z = importProc "ivory_stdlib_string_copy_z"
"ivory_stdlib_string_prim.h"
istr_from_sz :: forall s1 s2 eff len str.
(SingI len, IvoryString str)
=> Ref s1 str
-> ConstRef s2 (Array len (Stored Uint8))
-> Ivory eff ()
istr_from_sz dest src = do
len1 <- assign (stringCapacity (constRef dest))
ptr1 <- assign (stringData dest)
let len2 = fromIntegral (fromSing (sing :: Sing len))
ptr2 <- assign (toCArray src)
result <- call string_copy_z ptr1 len1 ptr2 len2
store (stringLength dest) (toIx result)
sz_from_istr :: forall s1 s2 eff len str.
(SingI len, IvoryString str)
=> Ref s1 (Array len (Stored Uint8))
-> ConstRef s2 str
-> Ivory eff ()
sz_from_istr dest src = do
let dest_capacity = fromSing (sing :: Sing len)
M.when (dest_capacity > 0) $ do
let dest_len = fromIntegral (dest_capacity 1)
src_data <- assign (stringData src)
src_len <- istr_len src
_result <- call string_copy (toCArray dest) dest_len src_data (fromIx src_len)
store (dest ! toIx (dest_len 1)) 0
copy_istring :: Def ('[ Ref s (CArray (Stored IChar))
, IString
, Uint32]
:-> ())
copy_istring = importProc "ivory_stdlib_strlcpy" "ivory_stdlib_string_prim.h"
class (IvoryType dest, IvoryType src) => Strcpy dest src where
strcpy :: dest -> src -> Ivory eff ()
instance (SingI len) => Strcpy (Ref s (Array len (Stored IChar))) IString where
strcpy dest src = call_ copy_istring (toCArray dest) src (arrayLen dest)
strncmp :: Def ('[ ConstRef s1 (CArray (Stored IChar))
, ConstRef s2 (CArray (Stored IChar))
, Uint32]
:-> Sint32)
strncmp = importProc "strncmp" "string.h"
strncpy :: Def ('[ Ref s1 (CArray (Stored IChar))
, ConstRef s2 (CArray (Stored IChar))
, Uint32
] :-> ())
strncpy = importProc "strncpy" "string.h"
strncpy_uint8 :: Def ('[ Ref s1 (CArray (Stored Uint8))
, ConstRef s2 (CArray (Stored IChar))
, Uint32
] :-> ())
strncpy_uint8 = importProc "ivory_stdlib_strncpy_uint8" "ivory_stdlib_string_prim.h"
stdlibStringModule :: Module
stdlibStringModule = package "ivory_stdlib_string" $ do
inclHeader "ivory_stdlib_string_prim.h"
inclHeader "string.h"
incl copy_istring
incl strncmp
incl memcmp
incl memcpy
incl do_istr_eq
incl string_copy
incl string_copy_z
sourceDep "ivory_stdlib_string_prim.h"
sourceDep "ivory_stdlib_string_prim.c"