husk-scheme 3.19.3 → 3.20

raw patch · 18 files changed

+89/−66 lines, 18 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.markdown +15/−1
• hs-src/Compiler/huskc.hs +1/−1
• hs-src/Interpreter/shell.hs +1/−1
• hs-src/Language/Scheme/Compiler.hs +3/−3
• hs-src/Language/Scheme/Compiler/Libraries.hs +8/−8
• hs-src/Language/Scheme/Core.hs +10/−10
• hs-src/Language/Scheme/Environments.hs +1/−1
• hs-src/Language/Scheme/Libraries.hs +1/−1
• hs-src/Language/Scheme/Macro.hs +2/−2
• hs-src/Language/Scheme/Macro/ExplicitRenaming.hs +1/−1
• hs-src/Language/Scheme/Numerical.hs +26/−20
• hs-src/Language/Scheme/Parser.hs +2/−2
• hs-src/Language/Scheme/Plugins/CPUTime.hs +1/−1
• hs-src/Language/Scheme/Primitives.hs +2/−2
• hs-src/Language/Scheme/Types.hs +2/−5
• hs-src/Language/Scheme/Variables.hs +1/−1
• husk-scheme.cabal +10/−5
• lib/srfi/1.sld +2/−1

@@ -1,7 +1,21 @@+v3.19.4+--------++Bug fixes:++- Incorporated fixes to allow husk to build with newer versions of GHC 8.++v3.19.4+--------++Bug fixes:++- Import `(scheme)` in SRFI 1, to prevent problems with missing the `receive` macro in compiled programs.+ v3.19.3 -------- -Big Fixes:+Bug Fixes:  - Fixed compilation errors in `FFI.hs`. 

@@ -16,7 +16,7 @@ import qualified Language.Scheme.Core import Language.Scheme.Types     -- Scheme data types import Language.Scheme.Variables -- Scheme variable operations-import Control.Monad.Error+import Control.Monad.Except import Data.Maybe (fromMaybe) import System.Console.GetOpt import System.FilePath (dropExtension)

@@ -16,7 +16,7 @@ import Language.Scheme.Types                 -- Scheme data types import qualified Language.Scheme.Util as LSU (countAllLetters, countLetters, strip) import qualified Language.Scheme.Variables as LSV -- Scheme variable operations-import Control.Monad.Error+import Control.Monad.Except import qualified Data.Char as DC import qualified Data.List as DL import Data.Maybe (fromMaybe)

@@ -58,7 +58,7 @@ import Language.Scheme.Primitives import Language.Scheme.Types import Language.Scheme.Variables-import Control.Monad.Error+import Control.Monad.Except import qualified Data.List import Data.Maybe (fromMaybe) @@ -1089,8 +1089,8 @@ compileSpecialFormBody :: Env                        -> LispVal                        -> CompOpts-                       -> (Maybe String -> ErrorT LispError IO [HaskAST])-                       -> ErrorT LispError IO [HaskAST]+                       -> (Maybe String -> ExceptT LispError IO [HaskAST])+                       -> ExceptT LispError IO [HaskAST] compileSpecialFormBody env                         ast@(List (Atom fnc : _))                         copts@(CompileOptions _ _ _ nextFunc) 

@@ -22,7 +22,7 @@ import Language.Scheme.Primitives import Language.Scheme.Types import Language.Scheme.Variables-import Control.Monad.Error+import Control.Monad.Except  -- |Import all given modules and generate code for them importAll @@ -59,7 +59,7 @@            -> LispVal            -> CompLibOpts            -> CompOpts-           -> ErrorT LispError IO [HaskAST]+           -> ExceptT LispError IO [HaskAST] _importAll env metaEnv m lopts copts = do     -- Resolve import     resolved <- LSC.evalLisp metaEnv $ @@ -78,7 +78,7 @@              -> [LispVal]              -> CompLibOpts              -> CompOpts-             -> ErrorT LispError IO [HaskAST]+             -> ExceptT LispError IO [HaskAST] importModule env metaEnv moduleName imports lopts               (CompileOptions thisFunc _ _ lastFunc) = do     Atom symImport <- _gensym "importFnc"@@ -210,7 +210,7 @@               -> LispVal               -> CompLibOpts               -> CompOpts-              -> ErrorT LispError IO [HaskAST]+              -> ExceptT LispError IO [HaskAST] compileModule env metaEnv name _mod lopts                (CompileOptions thisFunc _ _ lastFunc) = do     -- TODO: set mod meta-data to avoid cyclic references@@ -263,7 +263,7 @@           -> LispVal           -> CompLibOpts           -> CompOpts-          -> ErrorT LispError IO [HaskAST]+          -> ExceptT LispError IO [HaskAST] cmpSubMod env metaEnv (List ((List (Atom "import-immutable" : modules)) : ls))      lopts copts = do     -- Punt on this for now, although the meta-lang does the same thing@@ -293,7 +293,7 @@            -> LispVal            -> CompLibOpts            -> CompOpts-           -> ErrorT LispError IO [HaskAST]+           -> ExceptT LispError IO [HaskAST] cmpModExpr env metaEnv name (List ((List (Atom "include" : files)) : ls))      lopts@(CompileLibraryOptions _ compileLisp)     (CompileOptions thisFunc _ _ lastFunc) = do@@ -350,10 +350,10 @@               -> t3               -> [t2]               -> (t3-                  -> t2 -> String -> Maybe String -> ErrorT LispError IO [HaskAST])+                  -> t2 -> String -> Maybe String -> ExceptT LispError IO [HaskAST])               -> t1               -> CompOpts-              -> ErrorT LispError IO [HaskAST]+              -> ExceptT LispError IO [HaskAST] includeAll _ dir [file] include _ --lopts           (CompileOptions thisFunc _ _ lastFunc) = do     include dir file thisFunc lastFunc

@@ -62,7 +62,7 @@ import Language.Scheme.Types import Language.Scheme.Util import Language.Scheme.Variables-import Control.Monad.Error+import Control.Monad.Except import Data.Array import qualified Data.ByteString as BS import qualified Data.Map@@ -88,7 +88,7 @@   putStrLn " |_| |_|\\__,_|___/_|\\_\\  ///   \\\\\\  |___/\\___|_| |_|\\___|_| |_| |_|\\___| "   putStrLn "                                                                         "   putStrLn " http://justinethier.github.io/husk-scheme                              "-  putStrLn " (c) 2010-2016 Justin Ethier                                             "+  putStrLn " (c) 2010-2021 Justin Ethier                                             "   putStrLn $ " Version " ++ (DV.showVersion PHS.version) ++ " "   putStrLn "                                                                         " @@ -121,7 +121,7 @@ --  libraries. If the file is not found in the current directory but exists --  as a husk library, return the full path to the file in the library. --  Otherwise just return the given filename.-findFileOrLib :: String -> ErrorT LispError IO String+findFileOrLib :: String -> ExceptT LispError IO String findFileOrLib filename = do     fileAsLib <- liftIO $ getDataFileFullPath $ "lib/" ++ filename     exists <- fileExists [String filename]@@ -162,7 +162,7 @@ --  of just using show directly. showLispError :: LispError -> IO String showLispError (NumArgs n lvs) = do-  lvs' <- runErrorT $ mapM recDerefPtrs lvs+  lvs' <- runExceptT $ mapM recDerefPtrs lvs   case lvs' of     Left _ -> return $ show $ NumArgs n lvs     Right vals -> return $ show $ NumArgs n vals@@ -178,7 +178,7 @@     Right val -> showLispError $ BadSpecialForm str val showLispError (ErrorWithCallHist err hist) = do   err' <- showLispError err-  hist' <- runErrorT $ mapM recDerefPtrs hist+  hist' <- runExceptT $ mapM recDerefPtrs hist   case hist' of     Left _ -> return $ showCallHistory err' hist     Right vals -> return $ showCallHistory err' vals@@ -189,7 +189,7 @@ --  needed regardless of type. runIOThrowsREPL :: IOThrowsError String -> IO String runIOThrowsREPL action = do-    runState <- runErrorT action+    runState <- runExceptT action     case runState of         Left err -> showLispError err         Right val -> return val@@ -197,7 +197,7 @@ -- |Execute an IO action and return error or Nothing if no error was thrown. runIOThrows :: IOThrowsError String -> IO (Maybe String) runIOThrows action = do-    runState <- runErrorT action+    runState <- runExceptT action     case runState of         Left err -> do             disp <- showLispError err@@ -243,7 +243,7 @@ --    Right val -> putStrLn $ show val -- @ evalLisp' :: Env -> LispVal -> IO (ThrowsError LispVal)-evalLisp' env lisp = runErrorT (evalLisp env lisp)+evalLisp' env lisp = runExceptT (evalLisp env lisp)  -- |A wrapper for macroEval and eval meval, mprepareApply :: Env -> LispVal -> LispVal -> IOThrowsError LispVal@@ -871,7 +871,7 @@ -- |Helper function to perform CPS for vector-set! and similar forms createObjSetCPS :: String                    -> LispVal-                   -> (LispVal -> LispVal -> LispVal -> ErrorT LispError IO LispVal)+                   -> (LispVal -> LispVal -> LispVal -> ExceptT LispError IO LispVal)                    -> Env                    -> LispVal                    -> LispVal@@ -1349,7 +1349,7 @@ evalfuncImport _ = throwError $ InternalError ""  -- |Load import into the main environment-bootstrapImport :: [LispVal] -> ErrorT LispError IO LispVal+bootstrapImport :: [LispVal] -> ExceptT LispError IO LispVal bootstrapImport [cont@(Continuation {contClosure = env})] = do     LispEnv me <- getVar env "*meta-env*"     ri <- getNamespacedVar me macroNamespace "repl-import"

@@ -20,7 +20,7 @@ import Language.Scheme.Primitives import Language.Scheme.Types import Language.Scheme.Variables-import Control.Monad.Error+import Control.Monad.Except import qualified Data.Char import System.IO 

@@ -19,7 +19,7 @@     ) where import Language.Scheme.Types import Language.Scheme.Variables-import Control.Monad.Error+import Control.Monad.Except  -- |Get the full path to a module file findModuleFile 

@@ -52,7 +52,7 @@ import Language.Scheme.Macro.ExplicitRenaming import qualified Language.Scheme.Macro.Matches as Matches import Language.Scheme.Primitives (_gensym)-import Control.Monad.Error+import Control.Monad.Except import Data.Array -- import Debug.Trace -- Only req'd to support trace, can be disabled at any time... @@ -138,7 +138,7 @@ _macroEval :: Env            -> LispVal            -> (LispVal -> LispVal -> [LispVal] -> IOThrowsError LispVal)-           -> ErrorT LispError IO LispVal+           -> ExceptT LispError IO LispVal _macroEval env lisp@(List (Atom x : _)) apply = do   -- Note: If there is a procedure of the same name it will be shadowed by the macro.   var <- getNamespacedVar' env macroNamespace x

@@ -27,7 +27,7 @@ import Language.Scheme.Types import Language.Scheme.Variables import Language.Scheme.Primitives (_gensym)-import Control.Monad.Error+import Control.Monad.Except -- import Debug.Trace  -- |Handle an explicit renaming macro

@@ -71,7 +71,7 @@ ) where import Language.Scheme.Types -import Control.Monad.Error+import Control.Monad.Except import Data.Char hiding (isNumber) import Data.Complex import Data.Fixed@@ -180,7 +180,7 @@                     -> LispVal -> Either LispError LispVal)                     -> LispVal -> [LispVal] -> Either LispError LispVal numBoolBinopCompare cmp n1 (n2 : ns) = do-  List [n1', n2'] <- numCast [n1, n2]+  (n1', n2') <- numCast' (n1, n2)   result <- cmp n1' n2'   case result of     Bool True -> numBoolBinopCompare cmp n2' ns@@ -244,30 +244,36 @@     cmp _ _ = throwError $ Default "Unexpected error in <="  -- |Accept two numbers and cast one of them to the appropriate type, if necessary-numCast :: [LispVal] -> ThrowsError LispVal-numCast [a@(Number _), b@(Number _)] = return $ List [a, b]-numCast [a@(Float _), b@(Float _)] = return $ List [a, b]-numCast [a@(Rational _), b@(Rational _)] = return $ List [a, b]-numCast [a@(Complex _), b@(Complex _)] = return $ List [a, b]-numCast [(Number a), b@(Float _)] = return $ List [Float $ fromInteger a, b]-numCast [(Number a), b@(Rational _)] = return $ List [Rational $ fromInteger a, b]-numCast [(Number a), b@(Complex _)] = return $ List [Complex $ fromInteger a, b]-numCast [a@(Float _), (Number b)] = return $ List [a, Float $ fromInteger b]-numCast [a@(Float _), (Rational b)] = return $ List [a, Float $ fromRational b]-numCast [(Float a), b@(Complex _)] = return $ List [Complex $ a :+ 0, b]-numCast [a@(Rational _), (Number b)] = return $ List [a, Rational $ fromInteger b]-numCast [(Rational a), b@(Float _)] = return $ List [Float $ fromRational a, b]-numCast [(Rational a), b@(Complex _)] = return $ List [Complex $ (fromInteger $ numerator a) / (fromInteger $ denominator a), b]-numCast [a@(Complex _), (Number b)] = return $ List [a, Complex $ fromInteger b]-numCast [a@(Complex _), (Float b)] = return $ List [a, Complex $ b :+ 0]-numCast [a@(Complex _), (Rational b)] = return $ List [a, Complex $ (fromInteger $ numerator b) / (fromInteger $ denominator b)]-numCast [a, b] = case a of+numCast' :: (LispVal, LispVal) -> ThrowsError (LispVal, LispVal)+numCast' (a@(Number _), b@(Number _)) = return $ (a, b)+numCast' (a@(Float _), b@(Float _)) = return $ (a, b)+numCast' (a@(Rational _), b@(Rational _)) = return $ (a, b)+numCast' (a@(Complex _), b@(Complex _)) = return $ (a, b)+numCast' ((Number a), b@(Float _)) = return $ (Float $ fromInteger a, b)+numCast' ((Number a), b@(Rational _)) = return $ (Rational $ fromInteger a, b)+numCast' ((Number a), b@(Complex _)) = return $ (Complex $ fromInteger a, b)+numCast' (a@(Float _), (Number b)) = return $ (a, Float $ fromInteger b)+numCast' (a@(Float _), (Rational b)) = return $ (a, Float $ fromRational b)+numCast' ((Float a), b@(Complex _)) = return $ (Complex $ a :+ 0, b)+numCast' (a@(Rational _), (Number b)) = return $ (a, Rational $ fromInteger b)+numCast' ((Rational a), b@(Float _)) = return $ (Float $ fromRational a, b)+numCast' ((Rational a), b@(Complex _)) = return $ (Complex $ (fromInteger $ numerator a) / (fromInteger $ denominator a), b)+numCast' (a@(Complex _), (Number b)) = return $ (a, Complex $ fromInteger b)+numCast' (a@(Complex _), (Float b)) = return $ (a, Complex $ b :+ 0)+numCast' (a@(Complex _), (Rational b)) = return $ (a, Complex $ (fromInteger $ numerator b) / (fromInteger $ denominator b))+numCast' (a, b) = case a of                Number _ -> doThrowError b                Float _ -> doThrowError b                Rational _ -> doThrowError b                Complex _ -> doThrowError b                _ -> doThrowError a   where doThrowError num = throwError $ TypeMismatch "number" num++-- |Accept two numbers and cast one of them to the appropriate type, if necessary+numCast :: [LispVal] -> ThrowsError LispVal+numCast [a, b] = do+  (a', b') <- numCast' (a, b)+  pure $ List [a', b'] numCast _ = throwError $ Default "Unexpected error in numCast"  -- |Convert the given number to a rational

@@ -46,7 +46,7 @@     , parseUnquoteSpliced      ) where import Language.Scheme.Types-import Control.Monad.Error+import Control.Monad.Except import Data.Array import qualified Data.ByteString as BS import qualified Data.Char as DC@@ -319,7 +319,7 @@     _ -> return c  -- |Parse a hexidecimal scalar-parseHexScalar :: Monad m => String -> m Char+parseHexScalar :: String -> GenParser Char st Char parseHexScalar num = do     let ns = Numeric.readHex num     case ns of

@@ -20,7 +20,7 @@  import Language.Scheme.Types import System.CPUTime-import Control.Monad.Error+import Control.Monad.Except  -- |Wrapper for CPUTime.getCPUTime get :: [LispVal] -> IOThrowsError LispVal

@@ -161,7 +161,7 @@ import Language.Scheme.Types import Language.Scheme.Variables --import qualified Control.Exception-import Control.Monad.Error+import Control.Monad.Except import qualified Data.ByteString as BS import qualified Data.ByteString.UTF8 as BSU import Data.Char hiding (isSymbol)@@ -559,7 +559,7 @@              (MonadIO m, MonadError LispError m) =>              (Handle -> LispVal -> IO a) -> [LispVal] -> m LispVal -} writeProc :: (Handle -> LispVal -> IO a)-          -> [LispVal] -> ErrorT LispError IO LispVal+          -> [LispVal] -> ExceptT LispError IO LispVal writeProc func [obj] = do     dobj <- recDerefPtrs obj -- Last opportunity to do this before writing     writeProc func [dobj, Port stdout Nothing]

@@ -96,7 +96,7 @@     , validateFuncParams     )  where-import Control.Monad.Error+import Control.Monad.Except import Data.Complex import Data.Array import qualified Data.ByteString as BS@@ -165,9 +165,6 @@ showError (ErrorWithCallHist err stack) = showCallHistory (show err) stack  instance Show LispError where show = showError-instance Error LispError where-  noMsg = Default "An error has occurred"-  strMsg = Default  -- |Display call history for an error showCallHistory :: String -> [LispVal] -> String@@ -183,7 +180,7 @@ type ThrowsError = Either LispError  -- |Container used to provide error handling in the IO monad-type IOThrowsError = ErrorT LispError IO+type IOThrowsError = ExceptT LispError IO  -- |Lift a ThrowsError into the IO monad liftThrows :: ThrowsError a -> IOThrowsError a

@@ -54,7 +54,7 @@     , recDerefToFnc     ) where import Language.Scheme.Types-import Control.Monad.Error+import Control.Monad.Except import Data.Array import Data.IORef import qualified Data.Map

@@ -1,5 +1,5 @@ Name:                husk-scheme-Version:             3.19.3+Version:             3.20 Synopsis:            R5RS Scheme interpreter, compiler, and library. Description:            <<https://github.com/justinethier/husk-scheme/raw/master/docs/husk-scheme.png>>@@ -41,7 +41,7 @@ Maintainer:          Justin Ethier <github.com/justinethier> Homepage:            http://justinethier.github.com/husk-scheme Bug-Reports:         http://github.com/justinethier/husk-scheme/issues-Cabal-Version:       >= 1.8+Cabal-Version:       >= 1.10 Build-Type:          Simple Category:            Compilers/Interpreters, Language Tested-with:         GHC == 7.2.2, GHC == 7.0.2, GHC == 6.12.3, GHC == 6.10.4@@ -73,8 +73,9 @@     default: True  Library+  Default-Language: Haskell2010   Build-Depends:   base >= 2.0 && < 5, array, containers, haskeline, transformers, mtl, parsec, directory, bytestring, utf8-string, time, process, knob-  Extensions:      ExistentialQuantification+  Default-Extensions:      ExistentialQuantification   Hs-Source-Dirs:  hs-src   Exposed-Modules: Language.Scheme.Core                    Language.Scheme.Environments@@ -109,15 +110,18 @@     cpp-options: -DUsePointers  Executable         huski+  Default-Language: Haskell2010   Build-Depends:   husk-scheme, base >= 2.0 && < 5, array, containers, haskeline, transformers, mtl, parsec, directory, process   if flag(useffi)     Build-Depends: ghc, ghc-paths     cpp-options: -DUseFfi-  Extensions:      ExistentialQuantification+  Default-Extensions:      ExistentialQuantification   Main-is:         shell.hs   Hs-Source-Dirs:  hs-src/Interpreter+  Other-Modules:   Paths_husk_scheme  Executable huskc+  Default-Language: Haskell2010   Build-Depends: husk-scheme, base >= 2.0 && < 5, array, containers, haskeline, transformers, mtl, parsec, directory, ghc-paths, process, filepath   if flag(usedebug)     cpp-options: -DUseDebug@@ -126,6 +130,7 @@     cpp-options: -DUseFfi   if flag(useptrs)     cpp-options: -DUsePointers-  Extensions:      ExistentialQuantification+  Default-Extensions:      ExistentialQuantification   Main-is: huskc.hs   Hs-Source-Dirs: hs-src/Compiler+  Other-Modules:   Paths_husk_scheme

@@ -1,5 +1,6 @@ (define-library (srfi 1)     (export-all)-    (import (scheme base) +    (import (scheme)+            (scheme base)              (scheme cxr))     (include "srfi-1.scm"))