forked from GitHub/gf-core
overloading in ParadigmsFre
This commit is contained in:
@@ -40,6 +40,7 @@ import GF.Data.Operations
|
|||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.List (nub)
|
import Data.List (nub)
|
||||||
|
import Debug.Trace (trace)
|
||||||
|
|
||||||
renameGrammar :: SourceGrammar -> Err SourceGrammar
|
renameGrammar :: SourceGrammar -> Err SourceGrammar
|
||||||
renameGrammar g = liftM (MGrammar . reverse) $ foldM renameModule [] (modules g)
|
renameGrammar g = liftM (MGrammar . reverse) $ foldM renameModule [] (modules g)
|
||||||
@@ -70,22 +71,8 @@ renameIdentTerm :: Status -> Term -> Err Term
|
|||||||
renameIdentTerm env@(act,imps) t =
|
renameIdentTerm env@(act,imps) t =
|
||||||
errIn ("atomic term" +++ prt t +++ "given" +++ unwords (map (prt . fst) qualifs)) $
|
errIn ("atomic term" +++ prt t +++ "given" +++ unwords (map (prt . fst) qualifs)) $
|
||||||
case t of
|
case t of
|
||||||
Vr c -> case lookupTree prt c act of
|
Vr c -> ident predefAbs c
|
||||||
Ok f -> return $ f c
|
Cn c -> ident (\_ s -> Bad s) 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)
|
|
||||||
Q m' c | m' == cPredef {- && isInPredefined c -} -> return t
|
Q m' c | m' == cPredef {- && isInPredefined c -} -> return t
|
||||||
Q m' c -> do
|
Q m' c -> do
|
||||||
m <- lookupErr m' qualifs
|
m <- lookupErr m' qualifs
|
||||||
@@ -109,6 +96,17 @@ renameIdentTerm env@(act,imps) t =
|
|||||||
IC "String" -> return $ Q cPredefAbs cString
|
IC "String" -> return $ Q cPredefAbs cString
|
||||||
_ -> Bad s
|
_ -> 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?
|
--- | would it make sense to optimize this by inlining?
|
||||||
renameIdentPatt :: Status -> Patt -> Err Patt
|
renameIdentPatt :: Status -> Patt -> Err Patt
|
||||||
renameIdentPatt env p = do
|
renameIdentPatt env p = do
|
||||||
|
|||||||
Reference in New Issue
Block a user