Commit 21db66cb authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Various improvements, anonymous free vars now works - fixes #288

The improvements contain:
  - Module `OldScopeEnv` removed (content integrated into `CaseCompletion`
  - Intermediate structures from the checking phases can now
    also been dumped to stdout
  - Compiler options for additional dump targets added
  - Dumps now output the data type instead of its pretty printing
    to provide more information
  - Anonymous free variables are now renamed correctly
  - Erroneous shadowing warnings are fixed (was due to wrong renaming)
parent 8905d8f8
......@@ -8,7 +8,6 @@ Module overview of package `curry-frontend`
* `.Expr` : Type class for computation of free and bound variables
* `.Messages` : Error messages
* `.NestEnv` : Nested environment
* `.OldScopeEnv`: TODO: old stuff
* `.SCC` : Computation of strongly connected components
* `.ScopeEnv` : TODO: old stuff
* `.Subst` : general substitution implementation
......
......@@ -175,7 +175,7 @@ instance QualExpr ConstrTerm where
instance Expr TypeExpr where
fv (ConstructorType _ tys) = fv tys
fv (VariableType tv)
| tv == anonId = []
| isAnonId tv = []
| otherwise = [tv]
fv (TupleType tys) = fv tys
fv (ListType ty) = fv ty
......
......@@ -4,7 +4,7 @@ module Base.Messages
-- * program abortion
, abortWith, internalError, errorMessage, errorMessages
-- * creating messages
, Message, toMessage, posErr, qposErr, mposErr
, Message, toMessage, posMsg, qposMsg, mposMsg
) where
import Control.Monad (unless)
......@@ -46,11 +46,11 @@ errorMessage = error . show
errorMessages :: [Message] -> a
errorMessages = error . unlines . map show
posErr :: Ident -> String -> Message
posErr i errMsg = toMessage (idPosition i) errMsg
posMsg :: Ident -> String -> Message
posMsg i errMsg = toMessage (idPosition i) errMsg
qposErr :: QualIdent -> String -> Message
qposErr i errMsg = toMessage (qidPosition i) errMsg
qposMsg :: QualIdent -> String -> Message
qposMsg i errMsg = toMessage (qidPosition i) errMsg
mposErr :: ModuleIdent -> String -> Message
mposErr m errMsg = toMessage (midPosition m) errMsg
mposMsg :: ModuleIdent -> String -> Message
mposMsg m errMsg = toMessage (midPosition m) errMsg
module Base.OldScopeEnv
( ScopeEnv, newScopeEnv, beginScope, insertIdent, genIdentList
) where
import qualified Data.Map as Map
import Curry.Base.Ident
-- The IdEnv is an environment which stores the level in which an identifier
-- was defined, starting with 0 for the top-level.
data IdRep = Name String | Index Integer deriving (Eq, Ord)
type IdEnv = Map.Map IdRep Integer
insertId :: Integer -> Ident -> IdEnv -> IdEnv
insertId level ident = Map.insert (Name (idName ident)) level
. Map.insert (Index (idUnique ident)) level
nameExists :: String -> IdEnv -> Bool
nameExists name = Map.member (Name name)
indexExists :: Integer -> IdEnv -> Bool
indexExists index = Map.member (Index index)
genId :: String -> IdEnv -> Maybe Ident
genId n env
| nameExists n env = Nothing
| otherwise = Just (p_genId (mkIdent n) 0)
where
p_genId ident index
| indexExists index env = p_genId ident (index + 1)
| otherwise = renameIdent ident index
{- Type for representing an environment containing identifiers in several
scope levels -}
type ScopeLevel = Integer
type ScopeEnv = (IdEnv, [IdEnv], ScopeLevel)
-- (top-level IdEnv, stack of lower level IdEnv, current level)
-- Invariant: The current level is the number of stack elements
-- Generates a new instance of a scope table
newScopeEnv :: ScopeEnv
newScopeEnv = (Map.empty, [], 0)
-- Insert an identifier into the current level of the scope environment
insertIdent :: Ident -> ScopeEnv -> ScopeEnv
insertIdent ident (topleveltab, leveltabs, level) = case leveltabs of
[] -> ((insertId level ident topleveltab), [], 0)
(lt:lts) -> (topleveltab, (insertId level ident lt) : lts, level)
-- Increase the level of the scope.
beginScope :: ScopeEnv -> ScopeEnv
beginScope (topleveltab, leveltabs, level) = case leveltabs of
[] -> (topleveltab, [Map.empty], 1)
(lt:lts) -> (topleveltab, (lt:lt:lts), level + 1)
-- Generates a list of new identifiers where each identifier has
-- the prefix 'name' followed by an index (i.e. "var3" if 'name' was "var").
-- All returned identifiers are unique within the current scope.
genIdentList :: Int -> String -> ScopeEnv -> [Ident]
genIdentList size name scopeenv = p_genIdentList size name scopeenv 0
where
p_genIdentList :: Int -> String -> ScopeEnv -> Int -> [Ident]
p_genIdentList s n env i
| s == 0 = []
| otherwise = maybe (p_genIdentList s n env (i + 1))
(\ident -> ident:(p_genIdentList (s - 1)
n
(insertIdent ident env)
(i + 1)))
(genIdent (n ++ (show i)) env)
-- Generates a new identifier for the specified name. The new identifier is
-- unique within the current scope. If no identifier can be generated for
-- 'name' then 'Nothing' will be returned
genIdent :: String -> ScopeEnv -> Maybe Ident
genIdent name (topleveltab, leveltabs, _) = case leveltabs of
[] -> genId name topleveltab
(lt:_) -> genId name lt
-- OLD STUFF
-- -- Return the declaration level of an identifier if it exists
-- getIdentLevel :: Ident -> ScopeEnv -> Maybe Integer
-- getIdentLevel ident (topleveltab, leveltabs, _) = case leveltabs of
-- [] -> getIdLevel ident topleveltab
-- (lt:_) -> maybe (getIdLevel ident topleveltab) Just (getIdLevel ident lt)
-- -- Checkswhether the specified identifier is visible in the current scope
-- -- (i.e. check whether the identifier occurs in the scope environment)
-- isVisible :: Ident -> ScopeEnv -> Bool
-- isVisible ident (topleveltab, leveltabs, _) = case leveltabs of
-- [] -> idExists ident topleveltab
-- (lt:_) -> idExists ident lt || idExists ident topleveltab
--
-- -- Check whether the specified identifier is declared in the
-- -- current scope (i.e. checks whether the identifier occurs in the
-- -- current level of the scope environment)
-- isDeclared :: Ident -> ScopeEnv -> Bool
-- isDeclared ident (topleveltab, leveltabs, level) = case leveltabs of
-- [] -> maybe False ((==) 0) (getIdLevel ident topleveltab)
-- (lt:_) -> maybe False ((==) level) (getIdLevel ident lt)
-- -- Decrease the level of the scope. Identifier from higher levels
-- -- will be lost.
-- endScope :: ScopeEnv -> ScopeEnv
-- endScope (topleveltab, leveltabs, level) = case leveltabs of
-- [] -> (topleveltab, [], 0)
-- (_:lts) -> (topleveltab, lts, level - 1)
-- -- Return the level of the current scope. Top level is 0
-- getLevel :: ScopeEnv -> ScopeLevel
-- getLevel (_, _, level) = level
-- idExists :: Ident -> IdEnv -> Bool
-- idExists ident = indexExists (uniqueId ident)
-- getIdLevel :: Ident -> IdEnv -> Maybe Integer
-- getIdLevel ident = Map.lookup (Index (uniqueId ident))
......@@ -18,7 +18,7 @@ import Prelude hiding (lookup)
-- |Data type for representing information in nested scopes.
data ScopeEnv a b = ScopeEnv Int (Map.Map a (b,Int)) [Map.Map a (b,Int)]
deriving Show
deriving Show
-- |Returns an empty scope environment
new :: Ord a => ScopeEnv a b
......@@ -26,8 +26,8 @@ new = ScopeEnv 0 Map.empty []
-- |Inserts a value under a key into the environment of the current scope
insert :: Ord a => a -> b -> ScopeEnv a b -> ScopeEnv a b
insert key val env = modifySE insertLev env where
insertLev lev local = Map.insert key (val,lev) local
insert k v env = modifySE insertLev env where
insertLev lev local = Map.insert k (v,lev) local
{- |Updates the value stored under an existing key in the environment of
the current scope -}
......@@ -121,16 +121,15 @@ currentLevel env = selectSE const env
Privates...
--------------------------------------------------------------------------- -}
modifySE :: (Int -> Map.Map a (b,Int) -> Map.Map a (b,Int)) -> ScopeEnv a b
-> ScopeEnv a b
modifySE f (ScopeEnv _ top [])
= ScopeEnv 0 (f 0 top) []
modifySE f (ScopeEnv lev top (local:locals))
= ScopeEnv lev top ((f lev local):locals)
modifySE :: (Int -> Map.Map a (b, Int) -> Map.Map a (b, Int))
-> ScopeEnv a b
-> ScopeEnv a b
modifySE f (ScopeEnv _ top [] ) = ScopeEnv 0 (f 0 top) []
modifySE f (ScopeEnv lev top (l:ls)) = ScopeEnv lev top (f lev l:ls)
selectSE :: (Int -> Map.Map a (b,Int) -> c) -> ScopeEnv a b -> c
selectSE f (ScopeEnv _ top []) = f 0 top
selectSE f (ScopeEnv lev _ (local:_)) = f lev local
selectSE f (ScopeEnv _ top [] ) = f 0 top
selectSE f (ScopeEnv lev _ (l:_)) = f lev l
updateSE :: Ord a => Map.Map a (b,Int) -> (a,(b,Int)) -> Map.Map a (b,Int)
-> Map.Map a (b,Int)
......
......@@ -34,8 +34,11 @@ imported.
\begin{verbatim}
> module Base.TopEnv
> ( TopEnv (..), Entity (..), emptyTopEnv, predefTopEnv, importTopEnv
> , qualImportTopEnv, bindTopEnv, qualBindTopEnv, rebindTopEnv
> ( -- * Data types
> TopEnv (..), Entity (..)
> -- * creation and insertion
> , emptyTopEnv, predefTopEnv, importTopEnv, qualImportTopEnv
> , bindTopEnv, qualBindTopEnv, rebindTopEnv
> , qualRebindTopEnv, unbindTopEnv, lookupTopEnv, qualLookupTopEnv
> , allImports, moduleImports, localBindings, allLocalBindings
> ) where
......@@ -47,51 +50,58 @@ imported.
> import Curry.Base.Ident
> import Base.Messages (internalError)
> data Source = Local | Import [ModuleIdent] deriving (Eq, Show)
> class Entity a where
> origName :: a -> QualIdent
> merge :: a -> a -> Maybe a
> merge x y
> | origName x == origName y = Just x
> | otherwise = Nothing
> | otherwise = Nothing
> data Source = Local | Import [ModuleIdent] deriving (Eq, Show)
> newtype TopEnv a = TopEnv { topEnvMap :: Map.Map QualIdent [(Source, a)]
> } deriving Show
> -- |Top level environment
> newtype TopEnv a = TopEnv { topEnvMap :: Map.Map QualIdent [(Source, a)] }
> deriving Show
> instance Functor TopEnv where
> fmap f (TopEnv env) = TopEnv (fmap (map (second f)) env)
> -- local helper
> entities :: QualIdent -> Map.Map QualIdent [(Source, a)] -> [(Source, a)]
> entities = Map.findWithDefault []
> -- |Empty 'TopEnv'
> emptyTopEnv :: TopEnv a
> emptyTopEnv = TopEnv Map.empty
> -- |Insert an 'Entity' into a 'TopEnv' as a prefined 'Entity'
> predefTopEnv :: Entity a => QualIdent -> a -> TopEnv a -> TopEnv a
> predefTopEnv x y (TopEnv env) = case Map.lookup x env of
> predefTopEnv k v (TopEnv env) = case Map.lookup k env of
> Just _ -> internalError "TopEnv.predefTopEnv"
> Nothing -> TopEnv $ Map.insert x [(Import [], y)] env
> Nothing -> TopEnv $ Map.insert k [(Import [], v)] env
> -- |Insert an 'Entity' as unqualified into a 'TopEnv'
> importTopEnv :: Entity a => ModuleIdent -> Ident -> a -> TopEnv a
> -> TopEnv a
> importTopEnv m x y (TopEnv env) =
> TopEnv $ Map.insert x' (mergeImport m y (entities x' env)) env
> where x' = qualify x
> importTopEnv m x y env = addImport m (qualify x) y env
> -- |Insert an 'Entity' as qualified into a 'TopEnv'
> qualImportTopEnv :: Entity a => ModuleIdent -> Ident -> a -> TopEnv a
> -> TopEnv a
> qualImportTopEnv m x y (TopEnv env) =
> TopEnv $ Map.insert x' (mergeImport m y (entities x' env)) env
> where x' = qualifyWith m x
> mergeImport :: Entity a => ModuleIdent -> a -> [(Source, a)]
> -> [(Source, a)]
> mergeImport m x [] = [(Import [m], x)]
> mergeImport m x (loc@(Local , _) : xs) = loc : mergeImport m x xs
> mergeImport m x (imp@(Import ms, x') : xs) = case merge x x' of
> Just x'' -> (Import (m : ms), x'') : xs
> Nothing -> imp : mergeImport m x xs
> qualImportTopEnv m x y env = addImport m (qualifyWith m x) y env
> -- local helper
> addImport :: Entity a => ModuleIdent -> QualIdent -> a -> TopEnv a
> -> TopEnv a
> addImport m k v (TopEnv env) = TopEnv $
> Map.insert k (mergeImport v (entities k env)) env
> where
> mergeImport :: Entity a => a -> [(Source, a)] -> [(Source, a)]
> mergeImport y [] = [(Import [m], y)]
> mergeImport y (loc@(Local , _) : xs) = loc : mergeImport y xs
> mergeImport y (imp@(Import ms, y') : xs) = case merge y y' of
> Just y'' -> (Import (m : ms), y'') : xs
> Nothing -> imp : mergeImport y xs
> bindTopEnv :: String -> Ident -> a -> TopEnv a -> TopEnv a
> bindTopEnv fun x y env = qualBindTopEnv fun (qualify x) y env
......@@ -99,10 +109,11 @@ imported.
> qualBindTopEnv :: String -> QualIdent -> a -> TopEnv a -> TopEnv a
> qualBindTopEnv fun x y (TopEnv env) =
> TopEnv $ Map.insert x (bindLocal y (entities x env)) env
> where bindLocal y' ys
> | null [ y'' | (Local, y'') <- ys ] = (Local, y') : ys
> | otherwise = internalError $ "\"qualBindTopEnv " ++ show x
> ++ "\" failed in function \"" ++ fun ++ "\""
> where
> bindLocal y' ys
> | null [ y'' | (Local, y'') <- ys ] = (Local, y') : ys
> | otherwise = internalError $ "\"qualBindTopEnv " ++ show x
> ++ "\" failed in function \"" ++ fun
> rebindTopEnv :: Ident -> a -> TopEnv a -> TopEnv a
> rebindTopEnv = qualRebindTopEnv . qualify
......
......@@ -11,7 +11,7 @@ import Curry.Base.Ident
import Curry.Base.Position
import Curry.Syntax
import Base.Messages (Message, internalError, mposErr, posErr, qposErr)
import Base.Messages (Message, internalError, mposMsg, posMsg, qposMsg)
import Base.TopEnv
import Base.Types
import Base.Utils (findMultiples)
......@@ -239,21 +239,21 @@ isRecordType _ = False
-- ---------------------------------------------------------------------------
errUndefinedEntity :: QualIdent -> Message
errUndefinedEntity x = qposErr x $
errUndefinedEntity x = qposMsg x $
"Entity " ++ qualName x ++ " in export list is not defined"
errUndefinedType :: QualIdent -> Message
errUndefinedType tc = qposErr tc $
errUndefinedType tc = qposMsg tc $
"Type " ++ qualName tc ++ " in export list is not defined"
errModuleNotImported :: ModuleIdent -> Message
errModuleNotImported m = mposErr m $
errModuleNotImported m = mposMsg m $
"Module " ++ moduleName m ++ " not imported"
errMultipleExportType :: [Ident] -> Message
errMultipleExportType [] = internalError
"Checks.ExportCheck.errMultipleExportType: empty list"
errMultipleExportType (i:is) = posErr i $
errMultipleExportType (i:is) = posMsg i $
"Multiple exports of type " ++ idName i ++ " at:\n"
++ unlines (map showPos (i:is))
where showPos = (" " ++) . showLine . idPosition
......@@ -261,28 +261,28 @@ errMultipleExportType (i:is) = posErr i $
errMultipleExportValue :: [Ident] -> Message
errMultipleExportValue [] = internalError
"Checks.ExportCheck.errMultipleExportValue: empty list"
errMultipleExportValue (i:is) = posErr i $
errMultipleExportValue (i:is) = posMsg i $
"Multiple exports of " ++ idName i ++ " at:\n"
++ unlines (map showPos (i:is))
where showPos = (" " ++) . showLine . idPosition
errAmbiguousType :: QualIdent -> Message
errAmbiguousType tc = qposErr tc $ "Ambiguous type " ++ qualName tc
errAmbiguousType tc = qposMsg tc $ "Ambiguous type " ++ qualName tc
errAmbiguousName :: QualIdent -> Message
errAmbiguousName x = qposErr x $ "Ambiguous name " ++ qualName x
errAmbiguousName x = qposMsg x $ "Ambiguous name " ++ qualName x
errExportDataConstr :: QualIdent -> Message
errExportDataConstr c = qposErr c $
errExportDataConstr c = qposMsg c $
"Data constructor " ++ qualName c ++ " in export list"
errNonDataType :: QualIdent -> Message
errNonDataType tc = qposErr tc $ qualName tc ++ " is not a data type"
errNonDataType tc = qposMsg tc $ qualName tc ++ " is not a data type"
errUndefinedDataConstr :: QualIdent -> Ident -> Message
errUndefinedDataConstr tc c = posErr c $
errUndefinedDataConstr tc c = posMsg c $
idName c ++ " is not a data constructor of type " ++ qualName tc
errUndefinedLabel :: QualIdent -> Ident -> Message
errUndefinedLabel r l = posErr l $
errUndefinedLabel r l = posMsg l $
idName l ++ " is not a label of the record " ++ qualName r
......@@ -25,14 +25,14 @@ is defined more than once.
> module Checks.KindCheck (kindCheck) where
> import Control.Monad (forM, liftM, liftM2, liftM3, when)
> import Control.Monad (forM, liftM, liftM2, liftM3, unless, when)
> import qualified Control.Monad.State as S (State, runState, gets, modify)
> import Curry.Base.Ident
> import Curry.Base.Position
> import Curry.Syntax
> import Base.Messages (Message, posErr, qposErr, internalError)
> import Base.Messages (Message, posMsg, qposMsg, internalError)
> import Base.TopEnv
> import Base.Utils (findMultiples)
......@@ -159,7 +159,7 @@ traversed because they can contain local type signatures.
> checkTypeLhs :: [Ident] -> KCM [Ident]
> checkTypeLhs [] = return []
> checkTypeLhs (tv : tvs) = do
> when (tv /= anonId) $ do
> unless (isAnonId tv) $ do
> isTyCons <- (not . null . lookupKind tv) `liftM` getKindEnv
> when isTyCons $ report $ errNoVariable tv
> when (tv `elem` tvs) $ report $ errNonLinear tv
......@@ -263,8 +263,8 @@ interpret the identifier as such.
> _ -> report (errAmbiguousType tc) >> return c
> where n' = length tys
> checkType v@(VariableType tv)
> | tv == anonId = return v
> | otherwise = checkType $ ConstructorType (qualify tv) []
> | isAnonId tv = return v
> | otherwise = checkType $ ConstructorType (qualify tv) []
> checkType (TupleType tys) = TupleType `liftM` mapM checkType tys
> checkType (ListType ty) = ListType `liftM` checkType ty
> checkType (ArrowType ty1 ty2) =
......@@ -282,7 +282,7 @@ interpret the identifier as such.
> checkClosed tvs (ConstructorType tc tys) =
> ConstructorType tc `liftM` mapM (checkClosed tvs) tys
> checkClosed tvs v@(VariableType tv) = do
> when (tv == anonId || tv `notElem` tvs) $ report $ errUnboundVariable tv
> when (isAnonId tv || tv `notElem` tvs) $ report $ errUnboundVariable tv
> return v
> checkClosed tvs (TupleType tys) =
> TupleType `liftM` mapM (checkClosed tvs) tys
......@@ -314,29 +314,29 @@ Error messages:
\begin{verbatim}
> errUndefinedType :: QualIdent -> Message
> errUndefinedType tc = qposErr tc $ "Undefined type " ++ qualName tc
> errUndefinedType tc = qposMsg tc $ "Undefined type " ++ qualName tc
> errAmbiguousType :: QualIdent -> Message
> errAmbiguousType tc = qposErr tc $ "Ambiguous type " ++ qualName tc
> errAmbiguousType tc = qposMsg tc $ "Ambiguous type " ++ qualName tc
> errMultipleDeclaration :: [Ident] -> Message
> errMultipleDeclaration [] = internalError
> "KindCheck.errMultipleDeclaration: empty list"
> errMultipleDeclaration (i:is) = posErr i $
> errMultipleDeclaration (i:is) = posMsg i $
> "Multiple declarations for type `" ++ idName i ++ "` at:\n"
> ++ unlines (map showPos (i:is))
> where showPos = (" " ++) . showLine . idPosition
> errNonLinear :: Ident -> Message
> errNonLinear tv = posErr tv $ "Type variable " ++ idName tv ++
> errNonLinear tv = posMsg tv $ "Type variable " ++ idName tv ++
> " occurs more than once on left hand side of type declaration"
> errNoVariable :: Ident -> Message
> errNoVariable tv = posErr tv $ "Type constructor " ++ idName tv ++
> errNoVariable tv = posMsg tv $ "Type constructor " ++ idName tv ++
> " used in left hand side of type declaration"
> errWrongArity :: QualIdent -> Int -> Int -> Message
> errWrongArity tc arity argc = qposErr tc $
> errWrongArity tc arity argc = qposMsg tc $
> "Type constructor " ++ qualName tc ++ " expects " ++ arguments arity ++
> " but is applied to " ++ show argc
> where arguments 0 = "no arguments"
......@@ -344,6 +344,6 @@ Error messages:
> arguments n = show n ++ " arguments"
> errUnboundVariable :: Ident -> Message
> errUnboundVariable tv = posErr tv $ "Unbound type variable " ++ idName tv
> errUnboundVariable tv = posMsg tv $ "Unbound type variable " ++ idName tv
\end{verbatim}
......@@ -27,7 +27,7 @@ of the operators involved.
> import Curry.Syntax
> import Base.Expr
> import Base.Messages (Message, posErr, qposErr)
> import Base.Messages (Message, posMsg, qposMsg)
> import Base.Utils (findDouble)
> import Env.OpPrec (PEnv, OpPrec (..), PrecInfo (..), defaultP, bindP
......@@ -490,20 +490,20 @@ Error messages.
\begin{verbatim}
> errUndefinedOperator :: Ident -> Message
> errUndefinedOperator op = posErr op $
> errUndefinedOperator op = posMsg op $
> "no definition for " ++ idName op ++ " in this scope"
> errDuplicatePrecedence :: Ident -> Message
> errDuplicatePrecedence op = posErr op $
> errDuplicatePrecedence op = posMsg op $
> "More than one fixity declaration for " ++ idName op
> errInvalidParse :: String -> Ident -> QualIdent -> Message
> errInvalidParse what op1 op2 = posErr op1 $
> errInvalidParse what op1 op2 = posMsg op1 $
> "Invalid use of " ++ what ++ " " ++ idName op1
> ++ " with " ++ qualName op2 ++ (showLine $ qidPosition op2)
> errAmbiguousParse :: String -> QualIdent -> QualIdent -> Message
> errAmbiguousParse what op1 op2 = qposErr op1 $
> errAmbiguousParse what op1 op2 = qposMsg op1 $
> "Ambiguous use of " ++ what ++ " " ++ qualName op1
> ++ " with " ++ qualName op2 ++ (showLine $ qidPosition op2)
......
......@@ -33,7 +33,7 @@ definition.
> import Curry.Syntax
> import Base.Expr
> import Base.Messages (Message, toMessage, internalError, posErr, qposErr)
> import Base.Messages (Message, toMessage, internalError, posMsg, qposMsg)
> import Base.NestEnv
> import Base.Types
> import Base.Utils ((++!), findDouble, findMultiples)
......@@ -276,9 +276,8 @@ Furthermore, it is not allowed to declare a label more than once.
> bindVar :: Ident -> RenameEnv -> RenameEnv
> bindVar v env
> | v' == anonId = env
> | otherwise = bindLocal v' (LocalVar 0 v) env
> where v' = unRenameIdent v
> | isAnonId v = env
> | otherwise = bindLocal (unRenameIdent v) (LocalVar 0 v) env
> lookupVar :: Ident -> RenameEnv -> [RenameInfo]
> lookupVar v env = lookupNestEnv v env ++! lookupTupleConstr v
......@@ -544,8 +543,8 @@ checkParen
> checkConstrTerm _ (NegativePattern op l) =
> NegativePattern op `liftM` renameLiteral l
> checkConstrTerm p (VariablePattern v)
> | v == anonId = (VariablePattern . renameIdent v) `liftM` newId
> | otherwise = checkConstructorPattern p (qualify v) []
> | isAnonId v = (VariablePattern . renameIdent v) `liftM` newId
> | otherwise = checkConstructorPattern p (qualify v) []
> checkConstrTerm p (ConstructorPattern c ts) =
> checkConstructorPattern p c ts
> checkConstrTerm p (InfixPattern t1 op t2) =
......@@ -765,9 +764,12 @@ checkParen
> checkVariable :: QualIdent -> SCM Expression
> checkVariable v
> | unqualify v == anonId = do
> -- anonymous free variable
> | isAnonId (unqualify v) = do
> checkAnonFreeVarsExtension $ qidPosition v
> return $ Variable v
> (\n -> Variable $ updQualIdent id (flip renameIdent n) v) `liftM` newId
> -- return $ Variable v
> -- normal variable
> | otherwise = do
> env <- getRenameEnv
> case qualLookupVar v env of
......@@ -980,50 +982,50 @@ Error messages.
\begin{verbatim}
> errUndefinedVariable :: QualIdent -> Message
> errUndefinedVariable v = qposErr v $ qualName v ++ " is undefined"
> errUndefinedVariable v = qposMsg v $ qualName v ++ " is undefined"
> errUndefinedData :: QualIdent -> Message
> errUndefinedData c = qposErr c $ "Undefined data constructor " ++ qualName c
> errUndefinedData c = qposMsg c $ "Undefined data constructor " ++ qualName c
> errUndefinedLabel :: Ident -> Message
> errUndefinedLabel l = posErr l $ "Undefined record label `" ++ idName l ++ "`"
> errUndefinedLabel l = posMsg l $ "Undefined record label `" ++ idName l ++ "`"
> errAmbiguousIdent :: [RenameInfo] -> QualIdent -> Message
> errAmbiguousIdent rs | any isConstr rs = errAmbiguousData
> | otherwise = errAmbiguousVariable
> errAmbiguousVariable :: QualIdent -> Message
> errAmbiguousVariable v = qposErr v $ "Ambiguous variable " ++ qualName v
> errAmbiguousVariable v = qposMsg v $ "Ambiguous variable " ++ qualName v
> errAmbiguousData :: QualIdent -> Message
> errAmbiguousData c = qposErr c $ "Ambiguous data constructor " ++ qualName c
> errAmbiguousData c = qposMsg c $ "Ambiguous data constructor " ++ qualName c
> errDuplicateDefinition :: Ident -> Message
> errDuplicateDefinition v = posErr v $
> errDuplicateDefinition v = posMsg v $
> "More than one definition for `" ++ idName v ++ "`"
> errDuplicateVariable :: Ident -> Message
> errDuplicateVariable v = posErr v $