Commit 7162cb05 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Debugging improved

parent 39ead6a9
......@@ -37,7 +37,7 @@ imported.
> ( TopEnv (..), Entity (..), emptyTopEnv, predefTopEnv, importTopEnv
> , qualImportTopEnv, bindTopEnv, qualBindTopEnv, rebindTopEnv
> , qualRebindTopEnv, unbindTopEnv, lookupTopEnv, qualLookupTopEnv
> , allImports, moduleImports, localBindings
> , allImports, moduleImports, localBindings, allLocalBindings
> ) where
> import Control.Arrow (second)
......@@ -135,14 +135,18 @@ imported.
> unqualBindings :: TopEnv a -> [(Ident, (Source, a))]
> unqualBindings (TopEnv env) =
> [(x', y) | (x, ys) <- takeWhile (not . isQualified . fst) (Map.toList env)
> , let x' = unqualify x, y <- ys]
> [ (x', y) | (x, ys) <- filter (not . isQualified . fst) (Map.toList env)
> , let x' = unqualify x, y <- ys]
> moduleImports :: ModuleIdent -> TopEnv a -> [(Ident,a)]
> moduleImports :: ModuleIdent -> TopEnv a -> [(Ident, a)]
> moduleImports m env =
> [(x, y) | (x, (Import ms, y)) <- unqualBindings env, m `elem` ms]
> localBindings :: TopEnv a -> [(Ident,a)]
> localBindings :: TopEnv a -> [(Ident, a)]
> localBindings env = [ (x, y) | (x, (Local, y)) <- unqualBindings env ]
> allLocalBindings :: TopEnv a -> [(QualIdent, a)]
> allLocalBindings (TopEnv env) = [ (x, y) | (x, ys) <- Map.toList env
> , (Local, y) <- ys ]
\end{verbatim}
......@@ -17,7 +17,7 @@ import qualified Data.Map as Map (keys)
import Curry.Base.Ident (ModuleIdent)
import Base.TopEnv (localBindings)
import Base.TopEnv (allLocalBindings)
import Env.Eval
import Env.Interface
......@@ -55,9 +55,9 @@ showCompilerEnv env = unlines $ concat
[ header "ModuleIdent" $ show $ moduleIdent env
, header "Interfaces" $ show $ Map.keys $ interfaceEnv env
, header "ModuleAliases" $ show $ aliasEnv env
, header "TypeConstructors" $ show $ localBindings $ tyConsEnv env
, header "Values" $ show $ localBindings $ valueEnv env
, header "Precedences" $ show $ localBindings $ opPrecEnv env
, header "TypeConstructors" $ show $ allLocalBindings $ tyConsEnv env
, header "Values" $ show $ allLocalBindings $ valueEnv env
, header "Precedences" $ show $ allLocalBindings $ opPrecEnv env
, header "Eval Annotations" $ show $ evalAnnotEnv env
]
where header hdr content = [hdr, replicate (length hdr) '=', content]
\ No newline at end of file
......@@ -76,21 +76,21 @@ type ValueEnv = TopEnv ValueInfo
bindGlobalInfo :: (QualIdent -> a -> ValueInfo) -> ModuleIdent -> Ident -> a
-> ValueEnv -> ValueEnv
bindGlobalInfo f m c ty = bindTopEnv fun c v . qualBindTopEnv fun qc v
bindGlobalInfo f m c ty = bindTopEnv fun c v . qualBindTopEnv fun qc v
where qc = qualifyWith m c
v = f qc ty
fun = "Base.bindGlobalInfo"
fun = "Env.Value.bindGlobalInfo"
bindFun :: ModuleIdent -> Ident -> Int -> TypeScheme -> ValueEnv -> ValueEnv
bindFun m f a ty
| uniqueId f == 0 = bindTopEnv fun f v . qualBindTopEnv fun qf v
| otherwise = bindTopEnv fun f v
| uniqueId f == 0 = bindTopEnv fun f v . qualBindTopEnv fun qf v
| otherwise = bindTopEnv fun f v
where qf = qualifyWith m f
v = Value qf a ty
fun = "Base.bindFun"
fun = "Env.Value.bindFun"
qualBindFun :: ModuleIdent -> Ident -> Int -> TypeScheme -> ValueEnv -> ValueEnv
qualBindFun m f a ty = qualBindTopEnv "Base.qualBindFun" qf $
qualBindFun m f a ty = qualBindTopEnv "Env.Value.qualBindFun" qf $
Value qf a ty
where qf = qualifyWith m f
......@@ -106,7 +106,7 @@ unbindFun :: Ident -> ValueEnv -> ValueEnv
unbindFun = unbindTopEnv
bindLabel :: Ident -> QualIdent -> TypeScheme -> ValueEnv -> ValueEnv
bindLabel l r ty tyEnv = bindTopEnv "Base.bindLabel" l v tyEnv
bindLabel l r ty tyEnv = bindTopEnv "Env.Value.bindLabel" l v tyEnv
where v = Label (qualify l) r ty
lookupValue :: Ident -> ValueEnv -> [ValueInfo]
......
......@@ -386,10 +386,10 @@ qualifyLocal currentEnv initEnv = currentEnv
pEnv = opPrecEnv initEnv
tcEnv = tyConsEnv initEnv
tyEnv = valueEnv initEnv
bindQual (_, y) = qualBindTopEnv "Modules.qualifyEnv" (origName y) y
bindQual (_, y) = qualBindTopEnv "Imports.qualifyEnv" (origName y) y
bindGlobal (x, y)
| uniqueId x == 0 = bindQual (x, y)
| otherwise = bindTopEnv "Modules.qualifyEnv" x y
| otherwise = bindTopEnv "Imports.qualifyEnv" x y
-- Importing an interface into another interface is somewhat simpler
-- because all entities are imported into the environment. In addition,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment