ivory-stdlib 0.1.0.0 → 0.1.0.3
raw patch · 12 files changed
+189/−327 lines, 12 filesdep +ivory-artifactdep ~base
Dependencies added: ivory-artifact
Dependency ranges changed: base
Files
- ivory-stdlib.cabal +9/−9
- src/Ivory/Stdlib.hs +4/−2
- src/Ivory/Stdlib/Control.hs +5/−5
- src/Ivory/Stdlib/Init.hs +22/−0
- src/Ivory/Stdlib/Maybe.hs +14/−14
- src/Ivory/Stdlib/Memory.hs +8/−11
- src/Ivory/Stdlib/Operators.hs +8/−8
- src/Ivory/Stdlib/SearchDir.hs +0/−13
- src/Ivory/Stdlib/String.hs +119/−162
- src/Ivory/Stdlib/Trig.hs +0/−15
- support/ivory_stdlib_string_prim.c +0/−77
- support/ivory_stdlib_string_prim.h +0/−11
ivory-stdlib.cabal view
@@ -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
src/Ivory/Stdlib.hs view
@@ -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 =
src/Ivory/Stdlib/Control.hs view
@@ -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
+ src/Ivory/Stdlib/Init.hs view
@@ -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
src/Ivory/Stdlib/Maybe.hs view
@@ -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
src/Ivory/Stdlib/Memory.hs view
@@ -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)
src/Ivory/Stdlib/Operators.hs view
@@ -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)
− src/Ivory/Stdlib/SearchDir.hs
@@ -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"--
src/Ivory/Stdlib/String.hs view
@@ -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 <? stringCapacity str)- return 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 <? src_len+ let result_len = truncated ? (dest_len, src_len)+ call_ memcpy (toCArray dest) (stringData src) result_len+ store (dest ! toIx result_len) 0 -- | Ivory module definition. 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"++stdlibStringArtifacts :: [Located Artifact]+stdlibStringArtifacts =+ [ Incl $ supportfile "ivory_stdlib_string_prim.h"+ , Src $ supportfile "ivory_stdlib_string_prim.c"+ ]+ where+ supportfile f = artifactCabalFile P.getDataDir ("support/" ++ f)
− src/Ivory/Stdlib/Trig.hs
@@ -1,15 +0,0 @@--module Ivory.Stdlib.Trig- ( iAtan2- ) where--import Ivory.Language---- spec: http://en.wikipedia.org/wiki/Atan2-iAtan2 :: (IvoryOrd a, Floating a) => a -> a -> a-iAtan2 y x = ((x >? 0)?( atan(y/x)- ,((y >=? 0).&&(x <? 0))?( atan(y/x) + pi- ,((y <? 0).&&(x <? 0))?( atan(y/x) - pi- ,((y >? 0).&&(x ==? 0))?( pi/2- ,((y <? 0).&&(x ==? 0))?( -1*(pi/2)- ,0))))))
support/ivory_stdlib_string_prim.c view
@@ -2,83 +2,6 @@ #include "ivory_stdlib_string_prim.h" #include <string.h> -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 <Todd.Miller@courtesan.com>- * 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. *
support/ivory_stdlib_string_prim.h view
@@ -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 }