diff --git a/ChangeLog.markdown b/ChangeLog.markdown --- a/ChangeLog.markdown +++ b/ChangeLog.markdown @@ -1,3 +1,11 @@ +v3.15.2 +-------- + +Bug fixes: + +- The `(husk random)` library's `randint` function no longer throws a runtime error when called. +- The `newline` function now accepts a port as an optional second argument, instead of throwing an error. + v3.15.1 -------- diff --git a/hs-src/Language/Scheme/Core.hs b/hs-src/Language/Scheme/Core.hs --- a/hs-src/Language/Scheme/Core.hs +++ b/hs-src/Language/Scheme/Core.hs @@ -69,7 +69,7 @@ -- |husk version number version :: String -version = "3.15.1" +version = "3.15.2" -- |A utility function to display the husk console banner showBanner :: IO () @@ -82,7 +82,7 @@ putStrLn " |_| |_|\\__,_|___/_|\\_\\ /// \\\\\\ |___/\\___|_| |_|\\___|_| |_| |_|\\___| " putStrLn " " putStrLn " http://justinethier.github.io/husk-scheme " - putStrLn " (c) 2010-2013 Justin Ethier " + putStrLn " (c) 2010-2014 Justin Ethier " putStrLn $ " Version " ++ version ++ " " putStrLn " " diff --git a/hs-src/Language/Scheme/Primitives.hs b/hs-src/Language/Scheme/Primitives.hs --- a/hs-src/Language/Scheme/Primitives.hs +++ b/hs-src/Language/Scheme/Primitives.hs @@ -238,12 +238,26 @@ flushOutputPort [Port port] = liftIO $ hFlush port >> (return $ Bool True) flushOutputPort _ = return $ Bool False +-- | Determine if the given port is a text port. +-- +-- Arguments +-- +-- * Port +-- +-- Returns: Bool isTextPort :: [LispVal] -> IOThrowsError LispVal isTextPort [Port port] = do val <- liftIO $ isTextPort' port return $ Bool val isTextPort _ = return $ Bool False +-- | Determine if the given port is a binary port. +-- +-- Arguments +-- +-- * Port +-- +-- Returns: Bool isBinaryPort :: [LispVal] -> IOThrowsError LispVal isBinaryPort [Port port] = do val <- liftIO $ isTextPort' port @@ -258,7 +272,13 @@ Nothing -> return False _ -> return True - +-- | Determine if the given port is open +-- +-- Arguments +-- +-- * Port +-- +-- Returns: Bool isInputPortOpen :: [LispVal] -> IOThrowsError LispVal isInputPortOpen [Port port] = do r <- liftIO $ hIsReadable port @@ -266,6 +286,13 @@ return $ Bool $ r && o isInputPortOpen _ = return $ Bool False +-- | Determine if the given port is open +-- +-- Arguments +-- +-- * Port +-- +-- Returns: Bool isOutputPortOpen :: [LispVal] -> IOThrowsError LispVal isOutputPortOpen [Port port] = do w <- liftIO $ hIsWritable port @@ -360,6 +387,14 @@ return $ Char inpChr readCharProc _ args@(_ : _) = throwError $ BadSpecialForm "" $ List args +-- | Read a byte vector from the given port +-- +-- Arguments +-- +-- * Number - Number of bytes to read +-- * Port - Port to read from +-- +-- Returns: ByteVector readByteVector :: [LispVal] -> IOThrowsError LispVal readByteVector [Number n, Port port] = do input <- liftIO $ try' (liftIO $ BS.hGet port $ fromInteger n) @@ -424,6 +459,14 @@ then throwError $ TypeMismatch "(character port)" $ List other else throwError $ NumArgs (Just 2) other +-- | Write a byte vector to the given port +-- +-- Arguments +-- +-- * ByteVector +-- * Port +-- +-- Returns: (unspecified) writeByteVector :: [LispVal] -> IOThrowsError LispVal writeByteVector [obj, Port port] = do ByteVector bs <- recDerefPtrs obj -- Last opportunity to do this before writing @@ -600,6 +643,14 @@ cons [x1, x2] = return $ DottedList [x1] x2 cons badArgList = throwError $ NumArgs (Just 2) badArgList +-- | Create a new list +-- +-- Arguments +-- +-- * Number - Length of the list +-- * LispVal - Object to fill the list with (optional) +-- +-- Returns: List makeList :: [LispVal] -> ThrowsError LispVal makeList [(Number n)] = makeList [Number n, List []] makeList [(Number n), a] = do @@ -608,6 +659,13 @@ makeList [badType] = throwError $ TypeMismatch "integer" badType makeList badArgList = throwError $ NumArgs (Just 1) badArgList +-- | Create a copy of a list +-- +-- Arguments +-- +-- * List +-- +-- Returns: List listCopy :: [LispVal] -> IOThrowsError LispVal listCopy [p@(Pointer _ _)] = do l <- derefPtr p @@ -616,6 +674,15 @@ listCopy [badType] = return badType listCopy badArgList = throwError $ NumArgs (Just 1) badArgList +-- | Create a copy of a vector +-- +-- Arguments +-- +-- * Vector +-- * Number - Start copying the vector from this element (optional) +-- * Number - Stop copying the vector at this element (optional) +-- +-- Returns: Vector vectorCopy :: [LispVal] -> IOThrowsError LispVal vectorCopy (p@(Pointer _ _) : args) = do v <- derefPtr p @@ -1306,10 +1373,25 @@ listToString [] = throwError $ NumArgs (Just 1) [] listToString args@(_ : _) = throwError $ NumArgs (Just 1) args +-- | Convert a string to a vector +-- +-- Arguments +-- +-- * String +-- +-- Returns: Vector stringToVector :: [LispVal] -> IOThrowsError LispVal stringToVector args = do List l <- stringToList args return $ Vector $ listArray (0, length l - 1) l + +-- | Convert a vector to a string +-- +-- Arguments +-- +-- * Vector +-- +-- Returns: String vectorToString :: [LispVal] -> IOThrowsError LispVal vectorToString [p@(Pointer _ _)] = derefPtr p >>= box >>= vectorToString --vectorToString [(List [])] = return $ String "" @@ -1515,6 +1597,13 @@ charLower [notChar] = throwError $ TypeMismatch "char" notChar charLower args = throwError $ NumArgs (Just 1) args +-- | Return integer value of a char digit +-- +-- Arguments +-- +-- * Char +-- +-- Returns: Number, or False charDigitValue :: [LispVal] -> ThrowsError LispVal charDigitValue [Char c] = do -- This is not really good enough, since unicode chars @@ -1594,6 +1683,13 @@ isBoolean ([Bool _]) = return $ Bool True isBoolean _ = return $ Bool False +-- | Determine if multiple boolean values are the same +-- +-- Arguments +-- +-- * A list of Bool values +-- +-- Returns: True if the list contains booleans that are the same, False otherwise isBooleanEq :: Monad m => [LispVal] -> m LispVal isBooleanEq (Bool a : Bool b : bs) | a == b = isBooleanEq (Bool b : bs) @@ -1601,6 +1697,13 @@ isBooleanEq [Bool _] = return $ Bool True isBooleanEq _ = return $ Bool False +-- | Determine if multiple symbols values are the same +-- +-- Arguments +-- +-- * A list of Atom values +-- +-- Returns: True if all of the symbols are the same, False otherwise isSymbolEq :: Monad m => [LispVal] -> m LispVal isSymbolEq (Atom a : Atom b : bs) | a == b = isSymbolEq (Atom b : bs) diff --git a/husk-scheme.cabal b/husk-scheme.cabal --- a/husk-scheme.cabal +++ b/husk-scheme.cabal @@ -1,5 +1,5 @@ Name: husk-scheme -Version: 3.15.1 +Version: 3.15.2 Synopsis: R5RS Scheme interpreter, compiler, and library. Description: <> diff --git a/lib/core.scm b/lib/core.scm --- a/lib/core.scm +++ b/lib/core.scm @@ -370,7 +370,7 @@ (define (newline . port) (if (null? port) (display #\newline) - (display #\newline port))) + (display #\newline (car port)))) ; TODO: test these forms (define (call-with-input-file filename proc) diff --git a/lib/husk/random.scm b/lib/husk/random.scm --- a/lib/husk/random.scm +++ b/lib/husk/random.scm @@ -34,6 +34,6 @@ (define (randint . args) (cond ((= (length args) 1) (randint 0 (car args))) ((= (length args) 2) - (inexact->exact + (exact (+ (car args) (floor (* (random) (- (cadr args) (car args))))))) (else (error 'randint "usage: (randint [lo] hi)")))) diff --git a/lib/scheme/base.sld b/lib/scheme/base.sld --- a/lib/scheme/base.sld +++ b/lib/scheme/base.sld @@ -73,6 +73,8 @@ eqv? error even? + inexact->exact ; Added for convenience, not standard anymore + exact->inexact ; Added for convenience, not standard anymore (rename inexact->exact exact) (rename exact->inexact inexact) expt