diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -94,7 +94,7 @@ - [cabal-install](http://hackage.haskell.org/trac/hackage/wiki/CabalInstall) may be used to build, deploy, and generate packages for husk. - [Haskeline](http://trac.haskell.org/haskeline) - which may be installed using cabal: `cabal install haskeline` -The `scm-unit-tests` directory contains unit tests for much of the scheme code. All tests may be executed via the `make test` command. +The `tests` directory contains unit tests for much of the scheme code. All tests may be executed via the `make test` command. The `examples` directory contains example scheme programs. 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 @@ -7,19 +7,17 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This module contains Core functionality, primarily Scheme expression evaluation. -} module Language.Scheme.Core - ( eval - , evalLisp + ( + evalLisp , evalString , evalAndPrint , primitiveBindings + , apply + , continueEval ) where import qualified Language.Scheme.FFI import qualified Language.Scheme.Macro @@ -57,8 +55,7 @@ evalAndPrint :: Env -> String -> IO () evalAndPrint env expr = evalString env expr >>= putStrLn -{- |Evaluate lisp code that has already been loaded into haskell -FUTURE: code example for this, via ghci and/or a custom Haskell program. -} +-- |Evaluate lisp code that has already been loaded into haskell evalLisp :: Env -> LispVal -> IOThrowsError LispVal evalLisp env lisp = meval env (makeNullContinuation env) lisp @@ -96,7 +93,7 @@ return val -} -{- continueEval is a support function for eval, below. +{- |continueEval is a support function for eval. - - Transformed eval section into CPS by calling into this instead of returning from eval. - This function uses the cont argument to determine whether to keep going or to finally @@ -645,7 +642,7 @@ -> m LispVal makeVarargs = makeFunc . Just . showVal --- Call into a Scheme function +-- |Call into a Scheme function apply :: LispVal -> LispVal -> [LispVal] -> IOThrowsError LispVal apply _ cont@(Continuation env ccont ncont _ ndynwind) args = do -- case (trace ("calling into continuation. dynWind = " ++ show ndynwind) ndynwind) of @@ -705,6 +702,28 @@ -- Shortcut for calling continueEval continueWCont cwcEnv cwcBody cwcCont cwcDynWind = continueEval cwcEnv (Continuation cwcEnv (Just (SchemeBody cwcBody)) (Just cwcCont) Nothing cwcDynWind) $ Nil "" + + bindVarArgs arg env = case arg of + Just argName -> liftIO $ extendEnv env [((varNamespace, argName), List $ remainingArgs)] + Nothing -> return env +apply cont (HFunc aparams avarargs abody aclosure) args = + if num aparams /= num args && avarargs == Nothing + then throwError $ NumArgs (num aparams) args + else (liftIO $ extendEnv aclosure $ zip (map ((,) varNamespace) aparams) args) >>= bindVarArgs avarargs >>= (evalBody abody) + where remainingArgs = drop (length aparams) args + num = toInteger . length + evalBody evBody env = evBody env cont (Nil "") Nothing +{- TODO: may need to handle cases from Func, such as dynamic winders + case cont of + Continuation _ (Just (SchemeBody cBody)) (Just cCont) _ cDynWind -> if length cBody == 0 + then continueWCont env (evBody) cCont cDynWind + else continueWCont env (evBody) cont cDynWind -- Might be a problem, not fully optimizing + Continuation _ _ _ _ cDynWind -> continueWCont env (evBody) cont cDynWind + _ -> continueWCont env (evBody) cont Nothing + + -- Shortcut for calling continueEval + continueWCont cwcEnv cwcBody cwcCont cwcDynWind = + continueEval cwcEnv (Continuation cwcEnv (Just (SchemeBody cwcBody)) (Just cwcCont) Nothing cwcDynWind) $ Nil ""-} bindVarArgs arg env = case arg of Just argName -> liftIO $ extendEnv env [((varNamespace, argName), List $ remainingArgs)] diff --git a/hs-src/Language/Scheme/FFI.hs b/hs-src/Language/Scheme/FFI.hs --- a/hs-src/Language/Scheme/FFI.hs +++ b/hs-src/Language/Scheme/FFI.hs @@ -9,10 +9,6 @@ Stability : experimental Portability : non-portable (GHC API) -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This module contains the foreign function interface. -} module Language.Scheme.FFI (evalfuncLoadFFI) where diff --git a/hs-src/Language/Scheme/Macro.hs b/hs-src/Language/Scheme/Macro.hs --- a/hs-src/Language/Scheme/Macro.hs +++ b/hs-src/Language/Scheme/Macro.hs @@ -7,10 +7,6 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This module contains code for hygienic macros. Hygienic macros are implemented using the algorithm from the paper @@ -25,6 +21,7 @@ At a high level, macro transformation is broken down into the following steps: + 0) Walk the input code looking for a macro definition or macro call. If a macro call is found - 1) Search for a rule that matches the input. During this process, any pattern variables in the input are loaded into a temporary environment 2) If a rule matches, diff --git a/hs-src/Language/Scheme/Macro/Matches.hs b/hs-src/Language/Scheme/Macro/Matches.hs --- a/hs-src/Language/Scheme/Macro/Matches.hs +++ b/hs-src/Language/Scheme/Macro/Matches.hs @@ -7,10 +7,6 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This module contains utility functions used to support macro processing, by storing and/or manipulating data involving 0-or-many matches. -} diff --git a/hs-src/Language/Scheme/Numerical.hs b/hs-src/Language/Scheme/Numerical.hs --- a/hs-src/Language/Scheme/Numerical.hs +++ b/hs-src/Language/Scheme/Numerical.hs @@ -7,10 +7,6 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This module implements the numerical tower. -} diff --git a/hs-src/Language/Scheme/Parser.hs b/hs-src/Language/Scheme/Parser.hs --- a/hs-src/Language/Scheme/Parser.hs +++ b/hs-src/Language/Scheme/Parser.hs @@ -8,10 +8,6 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This module implements parsing of Scheme code. -} diff --git a/hs-src/Language/Scheme/Plugins/CPUTime.hs b/hs-src/Language/Scheme/Plugins/CPUTime.hs --- a/hs-src/Language/Scheme/Plugins/CPUTime.hs +++ b/hs-src/Language/Scheme/Plugins/CPUTime.hs @@ -7,10 +7,6 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This module wraps System.CPUTime so that it can be used directly by Scheme code. More importantly, it serves as an example of how to wrap existing Haskell code so 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 @@ -7,10 +7,6 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This module contains Primitive functions written in Haskell. -} diff --git a/hs-src/Language/Scheme/Types.hs b/hs-src/Language/Scheme/Types.hs --- a/hs-src/Language/Scheme/Types.hs +++ b/hs-src/Language/Scheme/Types.hs @@ -7,13 +7,7 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - -This module contains top-level data type definitions and their associated functions, including: - - Scheme data types - - Scheme errors +This module contains top-level data type definitions, environments, error types, and associated functions. -} @@ -30,11 +24,14 @@ -- Environment management -- |A Scheme environment containing variable bindings of form @(namespaceName, variableName), variableValue@ -data Env = Environment {parentEnv :: (Maybe Env), bindings :: (IORef [((String, String), IORef LispVal)])} -- lookup via: (namespace, variable) +data Env = Environment { + parentEnv :: (Maybe Env), + bindings :: (IORef (Data.Map.Map (String, String) (IORef LispVal))) + } -- |An empty environment nullEnv :: IO Env -nullEnv = do nullBindings <- newIORef [] +nullEnv = do nullBindings <- newIORef $ Data.Map.fromList [] return $ Environment Nothing nullBindings -- Internal namespace for macros @@ -137,6 +134,12 @@ closure :: Env } -- ^Function + | HFunc {hparams :: [String], + hvararg :: (Maybe String), + hbody :: (Env -> LispVal -> LispVal -> Maybe [LispVal] -> IOThrowsError LispVal), + hclosure :: Env + } + -- ^Function formed from a Haskell function | IOFunc ([LispVal] -> IOThrowsError LispVal) -- ^Primitive function within the IO monad | EvalFunc ([LispVal] -> IOThrowsError LispVal) @@ -232,10 +235,34 @@ eqv [(HashTable arg1), (HashTable arg2)] = eqv [List $ (map (\ (x, y) -> List [x, y]) $ Data.Map.toAscList arg1), List $ (map (\ (x, y) -> List [x, y]) $ Data.Map.toAscList arg2)] +-- +-- This comparison function may be too simplistic. Basically we check to see if +-- functions have the same calling interface. If they do, then we compare the +-- function bodies for equality. +-- +--FUTURE: +-- +-- The real solution for this and many of the other comparison functions is to +-- assign memory locations to data. Then we can just compare memory locations +-- in cases such as this one. But that is a much larger change. +eqv [x@(Func _ _ xBody _), y@(Func _ _ yBody _)] = do + if (show x) /= (show y) + then return $ Bool False + else eqvList eqv [List xBody, List yBody] +eqv [x@(HFunc _ _ xBody _), y@(Func _ _ yBody _)] = do + if (show x) /= (show y) + then return $ Bool False + else return $ Bool True -- TODO: compare high-order functions... eqvList eqv [List xBody, List yBody] +-- +eqv [x@(PrimitiveFunc _), y@(PrimitiveFunc _)] = return $ Bool $ (show x) == (show y) +eqv [x@(IOFunc _), y@(IOFunc _)] = return $ Bool $ (show x) == (show y) +eqv [x@(EvalFunc _), y@(EvalFunc _)] = return $ Bool $ (show x) == (show y) +-- FUTURE: comparison of two continuations eqv [l1@(List _), l2@(List _)] = eqvList eqv [l1, l2] eqv [_, _] = return $ Bool False eqv badArgList = throwError $ NumArgs 2 badArgList +-- |Compare two lists of haskell values, using the given comparison function eqvList :: ([LispVal] -> ThrowsError LispVal) -> [LispVal] -> ThrowsError LispVal eqvList eqvFunc [(List arg1), (List arg2)] = return $ Bool $ (length arg1 == length arg2) && (all eqvPair $ zip arg1 arg2) @@ -281,10 +308,16 @@ (case varargs of Nothing -> "" Just arg -> " . " ++ arg) ++ ") ...)" +showVal (HFunc {hparams = args, hvararg = varargs, hbody = _, hclosure = _}) = + "(lambda (" ++ unwords (map show args) ++ + (case varargs of + Nothing -> "" + Just arg -> " . " ++ arg) ++ ") ...)" showVal (Port _) = "" showVal (IOFunc _) = "" showVal (EvalFunc _) = "" +-- |Convert a list of Lisp objects into a space-separated string unwordsList :: [LispVal] -> String unwordsList = unwords . map showVal diff --git a/hs-src/Language/Scheme/Variables.hs b/hs-src/Language/Scheme/Variables.hs --- a/hs-src/Language/Scheme/Variables.hs +++ b/hs-src/Language/Scheme/Variables.hs @@ -7,10 +7,6 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This module contains code for working with Scheme variables. -} @@ -19,7 +15,13 @@ import Language.Scheme.Types import Control.Monad.Error import Data.IORef +import qualified Data.Map + +-- TODO: convert from storing vars in a list to a more efficient +-- data structure using Data.Map + + {- Experimental code: -- From: http://rafaelbarreto.com/2011/08/21/comparing-objects-by-memory-location-in-haskell/ import Foreign @@ -52,7 +54,7 @@ printEnv :: Env -> IO String printEnv env = do binds <- liftIO $ readIORef $ bindings env - l <- mapM showVar binds + l <- mapM showVar $ Data.Map.toList binds return $ unlines l where showVar ((_, name), val) = do @@ -63,7 +65,9 @@ copyEnv :: Env -> IO Env copyEnv env = do binds <- liftIO $ readIORef $ bindings env - bindingList <- mapM addBinding binds >>= newIORef +-- bindingList <- mapM addBinding binds >>= newIORef + bindingListT <- mapM addBinding $ Data.Map.toList binds -- TODO: there is a more elegant way to write this here (and below, too) + bindingList <- newIORef $ Data.Map.fromList bindingListT return $ Environment (parentEnv env) bindingList -- TODO: recursively create a copy of parent also? where addBinding ((namespace, name), val) = do --ref <- newIORef $ liftIO $ readIORef val x <- liftIO $ readIORef val @@ -71,8 +75,11 @@ return ((namespace, name), ref) -- |Extend given environment by binding a series of values to a new environment. + +-- TODO: should be able to use Data.Map.fromList to ease construction of new Env extendEnv :: Env -> [((String, String), LispVal)] -> IO Env -extendEnv envRef abindings = do bindinglist <- mapM addBinding abindings >>= newIORef +extendEnv envRef abindings = do bindinglistT <- (mapM addBinding abindings) -- >>= newIORef + bindinglist <- newIORef $ Data.Map.fromList bindinglistT return $ Environment (Just envRef) bindinglist where addBinding ((namespace, name), val) = do ref <- newIORef val return ((namespace, name), ref) @@ -97,7 +104,8 @@ -- |Determine if a variable is bound in a given namespace isNamespacedBound :: Env -> String -> String -> IO Bool -isNamespacedBound envRef namespace var = (readIORef $ bindings envRef) >>= return . maybe False (const True) . lookup (namespace, var) +isNamespacedBound envRef namespace var = + (readIORef $ bindings envRef) >>= return . Data.Map.member (namespace, var) -- TODO: should isNamespacedBound be replaced with this? Probably, but one step at a time... isNamespacedRecBound :: Env -> String -> String -> IO Bool @@ -116,7 +124,7 @@ getNamespacedVar envRef namespace var = do binds <- liftIO $ readIORef $ bindings envRef - case lookup (namespace, var) binds of + case Data.Map.lookup (namespace, var) binds of (Just a) -> liftIO $ readIORef a Nothing -> case parentEnv envRef of (Just par) -> getNamespacedVar par namespace var @@ -135,7 +143,7 @@ setNamespacedVar envRef namespace var value = do env <- liftIO $ readIORef $ bindings envRef - case lookup (namespace, var) env of + case Data.Map.lookup (namespace, var) env of (Just a) -> do -- vprime <- liftIO $ readIORef a liftIO $ writeIORef a value return value @@ -154,5 +162,5 @@ else liftIO $ do valueRef <- newIORef value env <- readIORef $ bindings envRef - writeIORef (bindings envRef) (((namespace, var), valueRef) : env) + writeIORef (bindings envRef) (Data.Map.insert (namespace, var) valueRef env) -- (((namespace, var), valueRef) : env) return value diff --git a/hs-src/shell.hs b/hs-src/shell.hs --- a/hs-src/shell.hs +++ b/hs-src/shell.hs @@ -7,10 +7,6 @@ Stability : experimental Portability : portable -husk scheme interpreter - -A lightweight dialect of R5RS scheme. - This file implements a REPL "shell" to host the interpreter, and also allows execution of stand-alone files containing Scheme code. -} @@ -67,8 +63,9 @@ putStrLn " | | | | |_| \\__ \\ < /// \\\\\\ \\__ \\ (__| | | | __/ | | | | | __/ " putStrLn " |_| |_|\\__,_|___/_|\\_\\ /// \\\\\\ |___/\\___|_| |_|\\___|_| |_| |_|\\___| " putStrLn " " - putStrLn " http://justinethier.github.com/husk-scheme Version 3.4.4 " - putStrLn " (c) 2010-2011 Justin Ethier " + putStrLn " http://justinethier.github.com/husk-scheme " + putStrLn " (c) 2010-2012 Justin Ethier " + putStrLn " Version 3.5.1 " putStrLn " " runRepl :: IO () 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.4.4 +Version: 3.5.1 Synopsis: R5RS Scheme interpreter program and library. Description: A dialect of R5RS Scheme written in Haskell. Provides advanced features including continuations, hygienic macros, a Haskell FFI, @@ -8,15 +8,19 @@ License-file: LICENSE Author: Justin Ethier Maintainer: Justin Ethier -Homepage: https://github.com/justinethier/husk-scheme -Cabal-Version: >= 1.4 +Homepage: http://justinethier.github.com/husk-scheme +Cabal-Version: >= 1.6 Build-Type: Simple Category: Compilers/Interpreters, Language -Tested-with: GHC == 7.0.2, GHC == 6.12.3, GHC == 6.10.4 +Tested-with: GHC == 7.2.2, GHC == 7.0.2, GHC == 6.12.3, GHC == 6.10.4 Extra-Source-Files: README.markdown LICENSE Data-Files: stdlib.scm + +Source-Repository head + Type: git + Location: git://github.com/justinethier/husk-scheme.git Library Build-Depends: base >= 2.0 && < 5, array, containers, haskeline, transformers, mtl, parsec, directory, ghc, ghc-paths