summaryrefslogtreecommitdiff
path: root/src/GF/Compile/Rename.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Compile/Rename.hs')
-rw-r--r--src/GF/Compile/Rename.hs30
1 files changed, 14 insertions, 16 deletions
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index d5561fcc6..52fb44211 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -40,6 +40,7 @@ import GF.Data.Operations
import Control.Monad
import Data.List (nub)
+import Debug.Trace (trace)
renameGrammar :: SourceGrammar -> Err SourceGrammar
renameGrammar g = liftM (MGrammar . reverse) $ foldM renameModule [] (modules g)
@@ -70,22 +71,8 @@ renameIdentTerm :: Status -> Term -> Err Term
renameIdentTerm env@(act,imps) t =
errIn ("atomic term" +++ prt t +++ "given" +++ unwords (map (prt . fst) qualifs)) $
case t of
- Vr c -> case lookupTree prt c act of
- Ok f -> return $ f c
- _ -> case lookupTreeManyAll prt opens c of
- [f] -> return $ f c
- [] -> predefAbs c ("constant not found:" +++ prt c)
- fs -> case nub [f c | f <- fs] of
- [tr] -> return tr
- ts -> Bad $ "conflicting imports:" +++ unwords (map prt ts)
- Cn c -> case lookupTree prt c act of
- Ok f -> return $ f c
- _ -> case lookupTreeManyAll prt opens c of
- [f] -> return $ f c
- [] -> Bad ("constant not found:" +++ prt c)
- fs -> case nub [f c | f <- fs] of
- [tr] -> return tr
- ts -> Bad $ "conflicting imports:" +++ unwords (map prt ts)
+ Vr c -> ident predefAbs c
+ Cn c -> ident (\_ s -> Bad s) c
Q m' c | m' == cPredef {- && isInPredefined c -} -> return t
Q m' c -> do
m <- lookupErr m' qualifs
@@ -109,6 +96,17 @@ renameIdentTerm env@(act,imps) t =
IC "String" -> return $ Q cPredefAbs cString
_ -> Bad s
+ ident alt c = case lookupTree prt c act of
+ Ok f -> return $ f c
+ _ -> case lookupTreeManyAll prt opens c of
+ [f] -> return $ f c
+ [] -> alt c ("constant not found:" +++ prt c)
+ fs -> case nub [f c | f <- fs] of
+ [tr] -> return tr
+ ts@(tr:_) ->
+ Bad $ "conflicting imports:" +++ unwords (map prt ts)
+
+
--- | would it make sense to optimize this by inlining?
renameIdentPatt :: Status -> Patt -> Err Patt
renameIdentPatt env p = do