husk-scheme 3.19.1 → 3.19.2

raw patch · 8 files changed

+65/−38 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.markdown +13/−0
• hs-src/Language/Scheme/Core.hs +35/−2
• hs-src/Language/Scheme/Environments.hs +0/−1
• hs-src/Language/Scheme/Numerical.hs +1/−2
• hs-src/Language/Scheme/Primitives.hs +0/−26
• husk-scheme.cabal +1/−1
• lib/core.scm +14/−5
• lib/srfi/69.sld +1/−1

@@ -1,3 +1,16 @@+v3.19.2+--------++New Features:++- Allow a `default` thunk to be passed to `hash-table-ref`.+- Added `hash-table-ref/default`.++Bug Fixes:++- Fixed `rational?` to properly handle floating-point numbers.+- Migrated `string-fill!` from a macro to a function. This makes it easier to redefine, for example per SRFI 13.+ v3.19.1 -------- 

@@ -43,6 +43,7 @@     , updateList     , updateVector     , updateByteVector+    , hashTblRef     -- * Error handling     , addToCallHistory     , throwErrorWithCallHistory@@ -87,7 +88,7 @@   putStrLn " |_| |_|\\__,_|___/_|\\_\\  ///   \\\\\\  |___/\\___|_| |_|\\___|_| |_| |_|\\___| "   putStrLn "                                                                         "   putStrLn " http://justinethier.github.io/husk-scheme                              "-  putStrLn " (c) 2010-2015 Justin Ethier                                             "+  putStrLn " (c) 2010-2016 Justin Ethier                                             "   putStrLn $ " Version " ++ (DV.showVersion PHS.version) ++ " "   putStrLn "                                                                         " @@ -1075,7 +1076,7 @@ nullEnvWithImport = nullEnv >>=    (flip extendEnv [     ((varNamespace, "%import"), EvalFunc evalfuncImport),-    ((varNamespace, "hash-table-ref"), IOFunc $ wrapHashTbl hashTblRef)])+    ((varNamespace, "hash-table-ref"), EvalFunc hashTblRef)])  -- |Load the standard r5rs environment, including libraries r5rsEnv :: IO Env@@ -1426,6 +1427,7 @@                   , ("current-environment", evalfuncInteractionEnv)                   , ("interaction-environment", evalfuncInteractionEnv)                   , ("make-environment", evalfuncMakeEnv)+                  , ("hash-table-ref", hashTblRef)                 -- Non-standard extensions #ifdef UseFfi@@ -1452,3 +1454,34 @@ addToCallHistory f history    | null history = [f]   | otherwise = (lastN' 9 history) ++ [f]++-- | Retrieve the value from the hashtable for the given key.+--   An error is thrown if the key is not found.+--+--   Note this had to be made an EvalFunc because a thunk+--   can be passed as an optional argument to be executed +--   if the key is not found.+--+--   Arguments:+--+--   * Current continuation+--   * HashTable to copy+--   * Object that is the key to query the table for+--+--   Returns: Object containing the key's value+--+hashTblRef :: [LispVal] -> IOThrowsError LispVal+hashTblRef [_, (HashTable ht), key] = do+  case Data.Map.lookup key ht of+    Just val -> return val+    Nothing -> throwError $ BadSpecialForm "Hash table does not contain key" key+hashTblRef [cont, (HashTable ht), key, thunk] = do+  case Data.Map.lookup key ht of+    Just val -> return $ val+    Nothing -> apply cont thunk []+hashTblRef (cont : p@(Pointer _ _) : args) = do+  ht <- derefPtr p+  hashTblRef (cont : ht : args)+hashTblRef [_, badType] = throwError $ TypeMismatch "hash-table" badType+hashTblRef badArgList = throwError $ NumArgs (Just 2) (tail badArgList)+

@@ -132,7 +132,6 @@                ("hash-table?",       wrapHashTbl isHashTbl),               ("hash-table-exists?",wrapHashTbl hashTblExists),-              ("hash-table-ref",    wrapHashTbl hashTblRef),               ("hash-table-size",   wrapHashTbl hashTblSize),               ("hash-table->alist", wrapHashTbl hashTbl2List),               ("hash-table-keys",   wrapHashTbl hashTblKeys),

@@ -613,8 +613,7 @@ isRational :: [LispVal] -> ThrowsError LispVal isRational ([Number _]) = return $ Bool True isRational ([Rational _]) = return $ Bool True-isRational ([n@(Float _)]) = return $ Bool $ isFloatAnInteger n-                             -- FUTURE: not quite good enough, could be represented exactly and not an integer+isRational ([Float n]) = return $ Bool $ not $ isInfinite n  isRational _ = return $ Bool False  -- |Predicate to determine if given number is an integer.

@@ -44,7 +44,6 @@  , byteVectorStr2Utf  -- ** Hash Table  , hashTblExists - , hashTblRef  , hashTblSize   , hashTbl2List  , hashTblKeys@@ -1216,31 +1215,6 @@     Nothing -> return $ Bool False hashTblExists [] = throwError $ NumArgs (Just 2) [] hashTblExists args@(_ : _) = throwError $ NumArgs (Just 2) args---- | Retrieve the value from the hashtable for the given key.---   An error is thrown if the key is not found.------   Arguments:------   * HashTable to copy------   * Object that is the key to query the table for------   Returns: Object containing the key's value----hashTblRef :: [LispVal] -> ThrowsError LispVal-hashTblRef [(HashTable ht), key] = do-  case Data.Map.lookup key ht of-    Just val -> return val-    Nothing -> throwError $ BadSpecialForm "Hash table does not contain key" key-hashTblRef [(HashTable ht), key, Func {}] = do-  case Data.Map.lookup key ht of-    Just val -> return $ val-    Nothing -> throwError $ NotImplemented "thunk"-{- FUTURE: a thunk can optionally be specified, this drives definition of /default-Nothing -> apply thunk [] -}-hashTblRef [badType] = throwError $ TypeMismatch "hash-table" badType-hashTblRef badArgList = throwError $ NumArgs (Just 2) badArgList  -- | Return the number of key/value associations in the hashtable --

@@ -1,5 +1,5 @@ Name:                husk-scheme-Version:             3.19.1+Version:             3.19.2 Synopsis:            R5RS Scheme interpreter, compiler, and library. Description:            <<https://github.com/justinethier/husk-scheme/raw/master/docs/husk-scheme.png>>

@@ -331,11 +331,17 @@ ; End delayed evaluation section  ; String Section-(define-syntax string-fill!-  (syntax-rules ()-    ((_ _str _chr)-     (set! _str-           (make-string (string-length _str) _chr)))))+(define (string-fill! str fill . opts)+  (letrec* ((len (string-length str))+            (start (if (> (length opts) 0) (car opts) 0))+            (end (if (> (length opts) 1) (cadr opts) len))+            (loop (lambda (i)+                    (cond+                     ((= i end) str)+                     (else+                       (string-set! str i fill)+                       (loop (+ i 1)))))))+    (loop start)))  (define (string-concatenate l)      (apply string-append l)) @@ -404,6 +410,9 @@     (exit-fail))  ;; Hashtable derived forms+(define (hash-table-ref/default ht key default)+  (hash-table-ref ht key (lambda () default)))+ (define hash-table-walk   (lambda (ht proc)     (map 

@@ -6,7 +6,7 @@         ;hash-table-equivalence-function          ;hash-table-hash-function         hash-table-ref -        ;hash-table-ref/default +        hash-table-ref/default          ;hash-table-set!          ;TODO: should implement this: hash-table-delete!          hash-table-exists?