diff --git a/ivory-stdlib.cabal b/ivory-stdlib.cabal --- a/ivory-stdlib.cabal +++ b/ivory-stdlib.cabal @@ -1,7 +1,7 @@ name: ivory-stdlib -version: 0.1.0.0 +version: 0.1.0.3 author: Galois, Inc. -maintainer: pat@galois.com +maintainer: leepike@galois.com copyright: 2013 Galois, Inc. category: Language synopsis: Ivory standard library. @@ -16,23 +16,23 @@ source-repository this type: git location: https://github.com/GaloisInc/ivory - tag: hackage-stdlib-0100 + tag: hackage-stdlib-0103 library exposed-modules: Ivory.Stdlib, Ivory.Stdlib.Control, + Ivory.Stdlib.Init, + Ivory.Stdlib.Maybe, Ivory.Stdlib.Memory, Ivory.Stdlib.Operators, - Ivory.Stdlib.String, - Ivory.Stdlib.Trig, - Ivory.Stdlib.SearchDir, - Ivory.Stdlib.Maybe + Ivory.Stdlib.String other-modules: Paths_ivory_stdlib - build-depends: base >= 4.6 && < 4.7, + build-depends: base >= 4.6 && < 5, filepath, - ivory + ivory, + ivory-artifact hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Ivory/Stdlib.hs b/src/Ivory/Stdlib.hs --- a/src/Ivory/Stdlib.hs +++ b/src/Ivory/Stdlib.hs @@ -1,20 +1,22 @@ module Ivory.Stdlib ( module Ivory.Stdlib.Control + , module Ivory.Stdlib.Init + , module Ivory.Stdlib.Maybe , module Ivory.Stdlib.Memory , module Ivory.Stdlib.Operators , module Ivory.Stdlib.String - , module Ivory.Stdlib.Maybe , stdlibModules ) where import Ivory.Language (Module) import Ivory.Stdlib.Control +import Ivory.Stdlib.Init +import Ivory.Stdlib.Maybe import Ivory.Stdlib.Memory import Ivory.Stdlib.Operators import Ivory.Stdlib.String -import Ivory.Stdlib.Maybe stdlibModules :: [Module] stdlibModules = diff --git a/src/Ivory/Stdlib/Control.hs b/src/Ivory/Stdlib/Control.hs --- a/src/Ivory/Stdlib/Control.hs +++ b/src/Ivory/Stdlib/Control.hs @@ -7,14 +7,14 @@ ( ifte , when , unless - , cond_, cond, (==>) + , cond_, cond, (==>), Cond() ) where import Ivory.Language ifte :: ( IvoryStore a - , IvoryZero (Stored a) - , GetAlloc eff ~ Scope s + , IvoryZero ('Stored a) + , GetAlloc eff ~ 'Scope s ) => IBool -> Ivory eff a -> Ivory eff a @@ -75,8 +75,8 @@ cond_ ((Cond b f):cs) = ifte_ b f (cond_ cs) cond :: ( IvoryStore a - , IvoryZero (Stored a) - , GetAlloc eff ~ Scope s + , IvoryZero ('Stored a) + , GetAlloc eff ~ 'Scope s ) => [Cond eff a] -> Ivory eff a cond as = do r <- local izero diff --git a/src/Ivory/Stdlib/Init.hs b/src/Ivory/Stdlib/Init.hs new file mode 100644 --- /dev/null +++ b/src/Ivory/Stdlib/Init.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE DataKinds #-} + +module Ivory.Stdlib.Init where + +import Ivory.Language + +-- | Variant of 'izero' that constrains the length of the array to match +-- a given type-level natural. This reduces the need for the +-- ScopedTypeVariables extension in Ivory code. +izerolen :: (IvoryArea area, IvoryZero area, ANat bound) + => Proxy bound + -> Init ('Array bound area) +izerolen _ = izero + +-- | Variant of 'iarray' that constrains the length of the array to +-- match a given type-level natural. This reduces the need for the +-- ScopedTypeVariables extension in Ivory code. +iarraylen :: (IvoryArea area, IvoryZero area, ANat bound) + => Proxy bound + -> [Init area] + -> Init ('Array bound area) +iarraylen _ = iarray diff --git a/src/Ivory/Stdlib/Maybe.hs b/src/Ivory/Stdlib/Maybe.hs --- a/src/Ivory/Stdlib/Maybe.hs +++ b/src/Ivory/Stdlib/Maybe.hs @@ -64,12 +64,12 @@ class (IvoryStruct sym, IvoryExpr t, IvoryStore t, IvoryInit t) => MaybeType (sym :: Symbol) t | sym -> t where -- | Return a boolean field indicating whether the value is valid. - maybeValidLabel :: Label sym (Stored IBool) + maybeValidLabel :: Label sym ('Stored IBool) -- | Return the field containing a value, if it is valid. - maybeValueLabel :: Label sym (Stored t) + maybeValueLabel :: Label sym ('Stored t) -- | Return an initializer for a maybe type with a valid value. -initJust :: MaybeType sym a => a -> Init (Struct sym) +initJust :: MaybeType sym a => a -> Init ('Struct sym) initJust x = istruct [ maybeValidLabel .= ival true @@ -77,7 +77,7 @@ ] -- | Return an initializer for a maybe type with no value. -initNothing :: MaybeType sym a => Init (Struct sym) +initNothing :: MaybeType sym a => Init ('Struct sym) initNothing = istruct [ maybeValidLabel .= ival false @@ -85,7 +85,7 @@ -- | Retrieve a maybe's value given a default if it is nothing. getMaybe :: MaybeType sym a - => ConstRef s1 (Struct sym) + => ConstRef s1 ('Struct sym) -> a -> Ivory eff a getMaybe ref def = do @@ -96,7 +96,7 @@ -- | Set a maybe's value to a default if it is nothing, returning -- the current value. setDefault :: MaybeType sym a - => Ref s1 (Struct sym) + => Ref s1 ('Struct sym) -> a -> Ivory eff a setDefault ref def = do @@ -105,7 +105,7 @@ -- | Set a maybe's value to a default value if it is nothing. setDefault_ :: MaybeType sym a - => Ref s1 (Struct sym) + => Ref s1 ('Struct sym) -> a -> Ivory eff () setDefault_ ref def = do @@ -118,14 +118,14 @@ -- | Modify a maybe value by an expression if it is not nothing. mapMaybe :: MaybeType sym a => (a -> a) - -> Ref s1 (Struct sym) + -> Ref s1 ('Struct sym) -> Ivory eff () mapMaybe f ref = mapMaybeM (return . f) ref -- | Modify a maybe value by an action if it is not nothing. mapMaybeM :: MaybeType sym a => (a -> Ivory eff a) - -> Ref s1 (Struct sym) + -> Ref s1 ('Struct sym) -> Ivory eff () mapMaybeM f ref = do valid <- deref (ref ~> maybeValidLabel) @@ -137,7 +137,7 @@ -- | Flipped version of 'mapMaybeM'. forMaybeM :: MaybeType sym a - => Ref s1 (Struct sym) + => Ref s1 ('Struct sym) -> (a -> Ivory eff a) -> Ivory eff () forMaybeM = flip mapMaybeM @@ -145,7 +145,7 @@ -- | Call an action with a maybe value if it is not nothing. mapMaybeM_ :: MaybeType sym a => (a -> Ivory eff ()) - -> Ref s1 (Struct sym) + -> Ref s1 ('Struct sym) -> Ivory eff () mapMaybeM_ f ref = do valid <- deref (ref ~> maybeValidLabel) @@ -156,14 +156,14 @@ -- | Flipped version of 'mapMaybeM_'. forMaybeM_ :: MaybeType sym a - => Ref s1 (Struct sym) + => Ref s1 ('Struct sym) -> (a -> Ivory eff ()) -> Ivory eff () forMaybeM_ = flip mapMaybeM_ -- | Set a maybe value to a valid value. setJust :: MaybeType sym a - => Ref s1 (Struct sym) + => Ref s1 ('Struct sym) -> a -> Ivory eff () setJust ref x = do @@ -172,7 +172,7 @@ -- | Set a maybe value to an invalid value. setNothing :: MaybeType sym a - => Ref s1 (Struct sym) + => Ref s1 ('Struct sym) -> Ivory eff () setNothing ref = store (ref ~> maybeValidLabel) false diff --git a/src/Ivory/Stdlib/Memory.hs b/src/Ivory/Stdlib/Memory.hs --- a/src/Ivory/Stdlib/Memory.hs +++ b/src/Ivory/Stdlib/Memory.hs @@ -2,7 +2,6 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ScopedTypeVariables #-} module Ivory.Stdlib.Memory ( resultInto @@ -15,11 +14,11 @@ -- | handy shorthand for transfering members resultInto :: IvoryStore a => - Ivory eff a -> Ref s (Stored a) -> Ivory eff () + Ivory eff a -> Ref s ('Stored a) -> Ivory eff () resultInto a b = store b =<< a into :: IvoryStore a => - Ref s (Stored a) -> Ref s' (Stored a) -> Ivory eff () + Ref s ('Stored a) -> Ref s' ('Stored a) -> Ivory eff () into a b = store b =<< deref a -- XXX Belongs with Pack.hs and SafePack.hs. @@ -30,15 +29,14 @@ -- is fully copied, the @to@ array is full, or index @end@ in the @from@ array -- is reached (index @end@ is not copied). to copy the full @from@ array, let -- @end@ equal 'arrayLen from'. -arrayCopy :: forall n m r s0 s1 s2 eff t. - ( SingI n, SingI m, IvoryRef r - , IvoryExpr (r s2 (Array m (Stored t))) - , IvoryExpr (r s2 (Stored t)) +arrayCopy :: + ( ANat n, ANat m, IvoryRef r + , IvoryExpr (r s2 ('Array m ('Stored t))) + , IvoryExpr (r s2 ('Stored t)) , IvoryStore t - , GetAlloc eff ~ Scope s0 ) - => Ref s1 (Array n (Stored t)) - -> r s2 (Array m (Stored t)) + => Ref s1 ('Array n ('Stored t)) + -> r s2 ('Array m ('Stored t)) -> Sint32 -> Sint32 -> Ivory eff () @@ -63,6 +61,5 @@ toLen = arrayLen to frLen = arrayLen from - mkIx :: Ix m -> Ix n mkIx ix = toIx (toOffset + fromIx ix) diff --git a/src/Ivory/Stdlib/Operators.hs b/src/Ivory/Stdlib/Operators.hs --- a/src/Ivory/Stdlib/Operators.hs +++ b/src/Ivory/Stdlib/Operators.hs @@ -8,17 +8,17 @@ -- | Infix structure field access and dereference. -- This is a shorthand for 'deref $ s~>x'. -(~>*) :: (IvoryVar a, IvoryStruct sym, IvoryRef ref, - IvoryExpr (ref s (Stored a)), - IvoryExpr (ref s (Struct sym))) => - ref s (Struct sym) -> Label sym (Stored a) -> Ivory eff a -struct ~>* label = deref $ struct~>label +(~>*) :: (IvoryVar a, IvoryStruct sym, IvoryRef ref, IvoryStore a, + IvoryExpr (ref s ('Stored a)), + IvoryExpr (ref s ('Struct sym))) => + ref s ('Struct sym) -> Label sym ('Stored a) -> Ivory eff a +struct ~>* label = deref (struct~>label) infixl 8 ~>* -- | Modify the value stored at a reference by a function. (%=) :: IvoryStore a => - Ref s (Stored a) -> (a -> a) -> Ivory eff () + Ref s ('Stored a) -> (a -> a) -> Ivory eff () ref %= f = do val <- deref ref store ref (f val) @@ -26,7 +26,7 @@ -- | Modify the value stored at a reference by a function that returns -- a value in the Ivory monad (%=!) :: IvoryStore a => - Ref s (Stored a) -> (a -> Ivory eff a) -> Ivory eff () + Ref s ('Stored a) -> (a -> Ivory eff a) -> Ivory eff () ref %=! mf = do val <- deref ref val' <- mf val @@ -34,6 +34,6 @@ -- | Increment the value stored at a reference. (+=) :: (Num a, IvoryStore a) => - Ref s (Stored a) -> a -> Ivory eff () + Ref s ('Stored a) -> a -> Ivory eff () ref += x = ref %= (+ x) diff --git a/src/Ivory/Stdlib/SearchDir.hs b/src/Ivory/Stdlib/SearchDir.hs deleted file mode 100644 --- a/src/Ivory/Stdlib/SearchDir.hs +++ /dev/null @@ -1,13 +0,0 @@ - -module Ivory.Stdlib.SearchDir where - -import System.FilePath - -import qualified Paths_ivory_stdlib - -searchDir :: IO FilePath -searchDir = do - base <- Paths_ivory_stdlib.getDataDir - return $ base "support" - - diff --git a/src/Ivory/Stdlib/String.hs b/src/Ivory/Stdlib/String.hs --- a/src/Ivory/Stdlib/String.hs +++ b/src/Ivory/Stdlib/String.hs @@ -1,11 +1,6 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE QuasiQuotes #-} + -- -- String.hs --- C-string utilities for Ivory. -- @@ -13,89 +8,116 @@ -- All Rights Reserved. -- -module Ivory.Stdlib.String where - -- ( copy_istring , strcpy , strncpy , strncpy_uint8 , strncmp - -- , stdlibStringModule - -- ) where +module Ivory.Stdlib.String + ( stdlibStringModule, stringInit, istr_eq, sz_from_istr, istr_len + , istr_from_sz, istr_copy, string_lit_store + , stdlibStringArtifacts, string_lit_array + ) where import Data.Char (ord) -import GHC.TypeLits import Ivory.Language +import Ivory.Language.Array (IxRep) +import Ivory.Artifact +import Ivory.Language.Struct import qualified Control.Monad as M +import qualified Paths_ivory_stdlib as P +-- Should be same underlying type as IxRep to make casting easier. +type Len = IxRep + ---------------------------------------------------------------------- -- Yet Another Ivory String Type --- TODO: Should we generate a warning or error if the string --- is too long for the string type? -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) +undefinedRef :: Label name field -> Ref s field +undefinedRef _ = undefined +-- | String initialization. Error returned if the `String` is too large. stringInit :: IvoryString str => String -> Init str -stringInit = gen_stringInit stringDataL stringLengthL +stringInit xs + | len > nat = + error $ "stringInit: String " ++ show xs + ++ " is too large to initialize dynamic string with" + ++ " maximum size " ++ show nat + | otherwise = + istruct + [ l_data .= iarray (map ival (stringArray xs)) + , stringLengthL .= ival (fromInteger len) + ] + where + l_data = stringDataL + len = toInteger (length xs) + nat = arrayLen (undefinedRef l_data) +-- | Store a constant string into an `IvoryString`. Error returned if the +-- `String` is too large. +string_lit_store :: IvoryString str + => String + -> Ref s str + -> Ivory eff () +string_lit_store s str = do + string_lit_array s (str ~> stringDataL) + store (str ~> stringLengthL) $ fromIntegral $ length s + +-- | Copy a Haskell string directly to an array of uint8s. +string_lit_array :: ANat n + => String + -> Ref s ('Array n ('Stored Uint8)) + -> Ivory eff () +string_lit_array s arr = + let go (ix, c) = store (arr ! fromInteger ix) c in + let ls = stringArray s in + let ln = toInteger (length ls) in + let nat = arrayLen arr in + if ln > nat + then error $ "string_lit_array: String " ++ show s + ++ " is too large for the dynamic string max size " + ++ show nat + else mapM_ go (zip [0..] ls) + +stringArray :: String -> [Uint8] +stringArray = map (fromIntegral . ord) + ---------------------------------------------------------------------- -- Generic Functions -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))) - --- Polymorphic "stringLength" function allowing read/write access --- to the string length. This is not exported, only a specialized --- read-only version. -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 +stringCapacity :: ( IvoryString str + , IvoryRef ref + , IvoryExpr (ref s ('Struct (StructName str))) + , IvoryExpr (ref s ('Array (Capacity ('Struct (StructName str))) ('Stored Uint8))) + , Num n + ) + => ref s str -> n +stringCapacity str = arrayLen (str ~> stringDataL) stringData :: ( IvoryString str , IvoryRef ref - , IvoryExpr (ref s (Array (Capacity str) (Stored Uint8))) - , IvoryExpr (ref s (CArray (Stored Uint8))) + , 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)) + => ref s str -> ref s ('CArray ('Stored Uint8)) stringData x = toCArray (x ~> stringDataL) +-- XXX don't export -- | Binding to the C "memcmp" function. -memcmp :: Def ('[ ConstRef s1 (CArray (Stored Uint8)) - , ConstRef s2 (CArray (Stored Uint8)) - , Sint32] :-> Sint32) +memcmp :: Def ('[ ConstRef s1 ('CArray ('Stored Uint8)) + , ConstRef s2 ('CArray ('Stored Uint8)) + , Len] ':-> Len) memcmp = importProc "memcmp" "string.h" +-- XXX don't export -- | Binding to the C "memcpy" function. -memcpy :: Def ('[ Ref s1 (CArray (Stored Uint8)) - , ConstRef s2 (CArray (Stored Uint8)) - , Sint32] :-> Sint32) +memcpy :: Def ('[ Ref s1 ('CArray ('Stored Uint8)) + , ConstRef s2 ('CArray ('Stored Uint8)) + , Len] ':-> Len) memcpy = importProc "memcpy" "string.h" -- | Return the length of a string. istr_len :: IvoryString str => ConstRef s str - -> Ivory eff (Ix (Capacity str)) -istr_len str = do - len <- deref (stringLength str) - assert (fromIx len Ivory eff Len +istr_len str = deref (str ~> stringLengthL) -- | Copy one string into another of the same type. istr_copy :: IvoryString str @@ -104,27 +126,15 @@ -> Ivory eff () istr_copy dest src = do len <- istr_len src - call_ memcpy (stringData dest) (stringData src) (fromIx len) - store (stringLength dest) len - --- | Copy one string to another of a possibly different type. If --- the destination string is too small, the output may be truncated. --- This returns true if the string fit, and false if it was --- truncated to fit the destination. --- --- TODO: Implement this once it's needed. -istr_convert :: (IvoryString str1, IvoryString str2) - => Ref s1 str1 - -> ConstRef s2 str2 - -> Ivory eff IBool -istr_convert = undefined + call_ memcpy (stringData dest) (stringData src) len + store (dest ~> stringLengthL) len -- | Internal function to compare strings for equality. -do_istr_eq :: Def ('[ ConstRef s1 (CArray (Stored Uint8)) - , Sint32 - , ConstRef s2 (CArray (Stored Uint8)) - , Sint32 - ] :-> IBool) +do_istr_eq :: Def ('[ ConstRef s1 ('CArray ('Stored Uint8)) + , Len + , ConstRef s2 ('CArray ('Stored Uint8)) + , Len + ] ':-> IBool) do_istr_eq = proc "ivory_string_eq" $ \s1 len1 s2 len2 -> body $ do ifte_ (len1 ==? len2) (do r <- call memcmp s1 s2 len1 @@ -143,21 +153,13 @@ ptr1 <- assign (stringData s1) len2 <- istr_len s2 ptr2 <- assign (stringData s2) - call do_istr_eq ptr1 (fromIx len1) ptr2 (fromIx len2) - --- | Primitive function to do a bounded string copy. -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" + call do_istr_eq ptr1 len1 ptr2 len2 -- | Primitive function to do a bounded null-terminated string copy. -string_copy_z :: Def ('[ Ref s1 (CArray (Stored Uint8)) - , Sint32 - , ConstRef s2 (CArray (Stored Uint8)) - , Sint32] :-> Sint32) +string_copy_z :: Def ('[ Ref s1 ('CArray ('Stored Uint8)) + , Len + , ConstRef s2 ('CArray ('Stored Uint8)) + , Len] ':-> Len) string_copy_z = importProc "ivory_stdlib_string_copy_z" "ivory_stdlib_string_prim.h" @@ -167,98 +169,53 @@ -- characters. -- -- FIXME: This should return false if the string was truncated. --- (Can we actually detect this at compile-time? I think we --- should be able to...) -istr_from_sz :: forall s1 s2 eff len str. - (SingI len, IvoryString str) +istr_from_sz :: (ANat len, IvoryString str) => Ref s1 str - -> ConstRef s2 (Array len (Stored Uint8)) + -> 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) + let len1 = stringCapacity dest + let ptr1 = stringData dest + let len2 = arrayLen src + let ptr2 = toCArray src + result <- call string_copy_z ptr1 len1 ptr2 len2 + store (dest ~> stringLengthL) result -- | Copy an Ivory string to a fixed-size, null-terminated C -- string. The destination string is always properly terminated, -- but may be truncated if the buffer is too small. -- -- FIXME: This should return false if the string was truncated. --- (Can we actually detect this at compile-time? I think we --- should be able to...) -sz_from_istr :: forall s1 s2 eff len str. - (SingI len, IvoryString str) - => Ref s1 (Array len (Stored Uint8)) +sz_from_istr :: (ANat 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) + let dest_capacity = arrayLen dest M.when (dest_capacity > 0) $ do - let dest_len = fromIntegral (dest_capacity - 1) - src_data <- assign (stringData src) + -- leave room for a trailing NUL in dest + let dest_len = fromInteger (dest_capacity - 1) src_len <- istr_len src - _result <- call string_copy (toCArray dest) dest_len src_data (fromIx src_len) - -- XXX is this right? shouldn't it use "result"? - store (dest ! toIx (dest_len - 1)) 0 - ----------------------------------------------------------------------- --- Old String Functions - --- TODO: Delete these if they aren't used anymore. - --- | Safely copy an IString (string literal) into a character array. --- The resulting string will always be null terminated. -copy_istring :: Def ('[ Ref s (CArray (Stored IChar)) -- dest - , IString -- src - , Uint32] -- len - :-> ()) -copy_istring = importProc "ivory_stdlib_strlcpy" "ivory_stdlib_string_prim.h" - --- | Type class to generate the correct call to a string function to --- copy one C string to another. -class (IvoryType dest, IvoryType src) => Strcpy dest src where - strcpy :: dest -> src -> Ivory eff () - --- | Strcpy instance for copying string constants to arrays of --- characters. -instance (SingI len) => Strcpy (Ref s (Array len (Stored IChar))) IString where - strcpy dest src = call_ copy_istring (toCArray dest) src (arrayLen dest) - --- | Binding to the C "strncmp" function. -strncmp :: Def ('[ ConstRef s1 (CArray (Stored IChar)) -- s1 - , ConstRef s2 (CArray (Stored IChar)) -- s2 - , Uint32] -- len - :-> 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" + let src_capacity = stringCapacity src + -- this can never truncate if dest is at least one byte bigger than src + let truncated = if dest_capacity > src_capacity then false else dest_len a -> a -> a -iAtan2 y x = ((x >? 0)?( atan(y/x) - ,((y >=? 0).&&(x ? 0).&&(x ==? 0))?( pi/2 - ,((y -void ivory_stdlib_strncpy_uint8(uint8_t *dest, const char *src, uint32_t size) { - strncpy((char*)dest, src, size); -} - -/* - * Copy src to string dst of size siz. At most siz-1 characters - * will be copied. Always NUL terminates (unless siz == 0). - * Returns strlen(src); if retval >= siz, truncation occurred. - * - * Copyright (c) 1998 Todd C. Miller - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, - * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL - * THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, - * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - */ -uint32_t ivory_stdlib_strlcpy(char *dest, const char *src, uint32_t size) -{ - char *d = dest; - const char *s = src; - uint32_t n = size; - - /* Copy as many bytes as will fit */ - if (n != 0 && --n != 0) { - do { - if ((*d++ = *s++) == 0) - break; - } while (--n != 0); - } - - /* Not enough room in dest, add NUL and traverse rest of src */ - if (n == 0) { - if (size != 0) - *d = '\0'; /* NUL-terminate dest */ - while (*s++) - ; - } - - return (s - src - 1); /* count does not include NUL */ -} - -/* Copy at most 'min(dest_len, src_len)' bytes from 'src' to - * dest. Returns the number of bytes written to 'dest', which - * is not null terminated. */ -int32_t ivory_stdlib_string_copy( - uint8_t *dest, int32_t dest_len, - const uint8_t *src, int32_t src_len) -{ - int32_t result = 0; - int32_t n = dest_len < src_len ? dest_len : src_len; - - for (int32_t i = 0; i < n; ++i) { - dest[i] = src[i]; - ++result; - } - - return result; -} - /* Copy at most 'min(dest_len, src_len)' bytes from 'src' to * dest, stopping early if a null terminator is encountered. * diff --git a/support/ivory_stdlib_string_prim.h b/support/ivory_stdlib_string_prim.h --- a/support/ivory_stdlib_string_prim.h +++ b/support/ivory_stdlib_string_prim.h @@ -16,10 +16,6 @@ extern "C" { #endif -uint32_t ivory_stdlib_strlcpy(char *dest, const char *src, uint32_t size); - -void ivory_stdlib_strncpy_uint8( uint8_t *dest, const char *src, uint32_t size); - /* Copy at most 'min(dest_len, src_len)' bytes from 'src' to * dest, stopping early if a null terminator is encountered. * @@ -28,13 +24,6 @@ int32_t ivory_stdlib_string_copy_z( uint8_t *dest, int32_t dest_len, const uint8_t *src, int32_t src_len); - -/* Copy at most 'min(dest_len, src_len)' bytes from 'src' to - * dest. Returns the number of bytes written to 'dest', which - * is not null terminated. */ -int32_t ivory_stdlib_string_copy( - uint8_t *dest, int32_t dest_len, - const uint8_t *src, int32_t src_len); #ifdef __cplusplus }