{-
- husk scheme
- Variables
-
- This file contains code for working with Scheme variables
-
- @author Justin Ethier
-
- -}moduleLanguage.Scheme.VariableswhereimportLanguage.Scheme.TypesimportControl.Monad.ErrorimportData.IORef-- |Extend given environment by binding a series of values to a new environment.extendEnv::Env->[((String,String),LispVal)]->IOEnvextendEnvenvRefbindings=dobindinglist<-mapM(\((namespace,name),val)->doref<-newIORefvalreturn((namespace,name),ref))bindings>>=newIORefreturn$Environment(JustenvRef)bindinglist{-
-- Old implementation, left for the moment for reference purposes only:
--
-- |Bind a series of values to the given environment.
--
-- Input is of form: @(namespaceName, variableName), variableValue@
bindVars :: Env -> [((String, String), LispVal)] -> IO Env
bindVars envRef abindings = (readIORef $ bindings envRef) >>= myExtendEnv abindings >>= newIORef
where myExtendEnv bindings env = liftM (++ env) (mapM addBinding bindings)
addBinding (var, value) = do ref <- newIORef value
return (var, ref)
-}-- |Determine if a variable is bound in the default namespaceisBound::Env->String->IOBoolisBoundenvRefvar=isNamespacedBoundenvRefvarNamespacevar-- |Determine if a variable is bound in a given namespaceisNamespacedBound::Env->String->String->IOBoolisNamespacedBoundenvRefnamespacevar=(readIORef$bindingsenvRef)>>=return.maybeFalse(constTrue).lookup(namespace,var)-- |Retrieve the value of a variable defined in the default namespacegetVar::Env->String->IOThrowsErrorLispValgetVarenvRefvar=getNamespacedVarenvRefvarNamespacevar-- |Retrieve the value of a variable defined in a given namespacegetNamespacedVar::Env->String->String->IOThrowsErrorLispValgetNamespacedVarenvRefnamespacevar=dobinds<-liftIO$readIORef$bindingsenvRefcaselookup(namespace,var)bindsof(Justa)->liftIO$readIORefaNothing->caseparentEnvenvRefof(Justpar)->getNamespacedVarparnamespacevarNothing->(throwError$UnboundVar"Getting an unbound variable"var)-- |Set a variable in the default namespacesetVar,defineVar::Env->String->LispVal->IOThrowsErrorLispValsetVarenvRefvarvalue=setNamespacedVarenvRefvarNamespacevarvalue-- ^Bind a variable in the default namespacedefineVarenvRefvarvalue=defineNamespacedVarenvRefvarNamespacevarvalue-- |Set a variable in a given namespacesetNamespacedVar::Env->String->String->LispVal->IOThrowsErrorLispValsetNamespacedVarenvRefnamespacevarvalue=doenv<-liftIO$readIORef$bindingsenvRefcaselookup(namespace,var)envof(Justa)->do--vprime <- liftIO $ readIORef aliftIO$writeIORefavaluereturnvalueNothing->caseparentEnvenvRefof(Justpar)->setNamespacedVarparnamespacevarvalueNothing->throwError$UnboundVar"Setting an unbound variable: "var-- |Bind a variable in the given namespacedefineNamespacedVar::Env->String->String->LispVal->IOThrowsErrorLispValdefineNamespacedVarenvRefnamespacevarvalue=doalreadyDefined<-liftIO$isNamespacedBoundenvRefnamespacevarifalreadyDefinedthensetNamespacedVarenvRefnamespacevarvalue>>returnvalueelseliftIO$dovalueRef<-newIORefvalueenv<-readIORef$bindingsenvRefwriteIORef(bindingsenvRef)(((namespace,var),valueRef):env)returnvalue