msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

lookup with more information

Browse Source
This commit is contained in:
aarne
2006-11-09 22:05:43 +00:00
parent 2fc97fa6fa
commit d3e1295243
2 changed files with 18 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
src/GF/Compile/GrammarToCanon.hs
View File

@@ -192,6 +192,7 @@ redCType t = case t of
App (Q (IC "Predef") (IC "Ints")) (EInt n) -> return $ G.TInts (toInteger n) App (Q (IC "Predef") (IC "Ints")) (EInt n) -> return $ G.TInts (toInteger n)
Sort "Str" -> return $ G.TStr Sort "Str" -> return $ G.TStr
Sort "Tok" -> return $ G.TStr
_ -> prtBad "cannot reduce to canonical the type" t _ -> prtBad "cannot reduce to canonical the type" t
redCTerm :: Term -> Err G.Term redCTerm :: Term -> Err G.Term

28
src/GF/Grammar/Lookup.hs
View File

@@ -14,7 +14,9 @@
-- lookup in resource and concrete in compiling; for abstract, use 'Look' -- lookup in resource and concrete in compiling; for abstract, use 'Look'
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Grammar.Lookup (lookupResDef, module GF.Grammar.Lookup (
lookupResDef,
lookupResDefKind,
lookupResType, lookupResType,
lookupParams, lookupParams,
lookupParamValues, lookupParamValues,
@@ -38,30 +40,34 @@ lock c = lockRecType c -- return
unlock c = unlockRecord c -- return unlock c = unlockRecord c -- return
lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term
lookupResDef gr m c = look True m c where lookupResDef gr m c = liftM fst $ lookupResDefKind gr m c
-- 0 = oper, 1 = lin, 2 = canonical. v > 0 means: no need to be recomputed
lookupResDefKind :: SourceGrammar -> Ident -> Ident -> Err (Term,Int)
lookupResDefKind gr m c = look True m c where
look isTop m c = do look isTop m c = do
mi <- lookupModule gr m mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupIdentInfo mo c info <- lookupIdentInfo mo c
case info of case info of
ResOper _ (Yes t) -> return $ qualifAnnot m t ResOper _ (Yes t) -> return (qualifAnnot m t, 0)
ResOper _ Nope -> return (Q m c) ---- if isTop then lookExt m c ResOper _ Nope -> return (Q m c, 0) ---- if isTop then lookExt m c
---- else prtBad "cannot find in exts" c ---- else prtBad "cannot find in exts" c
CncCat (Yes ty) _ _ -> lock c ty CncCat (Yes ty) _ _ -> liftM (flip (,) 1) $ lock c ty
CncCat _ _ _ -> lock c defLinType CncCat _ _ _ -> liftM (flip (,) 1) $ lock c defLinType
CncFun (Just (cat,_)) (Yes tr) _ -> unlock cat tr CncFun (Just (cat,_)) (Yes tr) _ -> liftM (flip (,) 1) $ unlock cat tr
CncFun _ (Yes tr) _ -> unlock c tr CncFun _ (Yes tr) _ -> liftM (flip (,) 1) $ unlock c tr
AnyInd _ n -> look False n c AnyInd _ n -> look False n c
ResParam _ -> return $ QC m c ResParam _ -> return (QC m c,2)
ResValue _ -> return $ QC m c ResValue _ -> return (QC m c,2)
_ -> Bad $ prt c +++ "is not defined in resource" +++ prt m _ -> Bad $ prt c +++ "is not defined in resource" +++ prt m
_ -> Bad $ prt m +++ "is not a resource" _ -> Bad $ prt m +++ "is not a resource"
lookExt m c = lookExt m c =
checks ([look False n c | n <- allExtensions gr m] ++ [return (Q m c)]) checks ([look False n c | n <- allExtensions gr m] ++ [return (Q m c,3)])
lookupResType :: SourceGrammar -> Ident -> Ident -> Err Type lookupResType :: SourceGrammar -> Ident -> Ident -> Err Type
lookupResType gr m c = do lookupResType gr m c = do