GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 13:09:33 -06:00
Code Issues Packages Projects Releases Wiki 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)
Sort "Str" -> return $ G.TStr
Sort "Tok" -> return $ G.TStr
_ -> prtBad "cannot reduce to canonical the type" t
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'
-----------------------------------------------------------------------------
module GF.Grammar.Lookup (lookupResDef,
module GF.Grammar.Lookup (
lookupResDef,
lookupResDefKind,
lookupResType,
lookupParams,
lookupParamValues,
@@ -38,30 +40,34 @@ lock c = lockRecType c -- return
unlock c = unlockRecord c -- return
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
mi <- lookupModule gr m
case mi of
ModMod mo -> do
info <- lookupIdentInfo mo c
case info of
ResOper _ (Yes t) -> return $ qualifAnnot m t
ResOper _ Nope -> return (Q m c) ---- if isTop then lookExt m c
ResOper _ (Yes t) -> return (qualifAnnot m t, 0)
ResOper _ Nope -> return (Q m c, 0) ---- if isTop then lookExt m c
---- else prtBad "cannot find in exts" c
CncCat (Yes ty) _ _ -> lock c ty
CncCat _ _ _ -> lock c defLinType
CncFun (Just (cat,_)) (Yes tr) _ -> unlock cat tr
CncCat (Yes ty) _ _ -> liftM (flip (,) 1) $ lock c ty
CncCat _ _ _ -> liftM (flip (,) 1) $ lock c defLinType
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
ResParam _ -> return $ QC m c
ResValue _ -> return $ QC m c
ResParam _ -> return (QC m c,2)
ResValue _ -> return (QC m c,2)
_ -> Bad $ prt c +++ "is not defined in resource" +++ prt m
_ -> Bad $ prt m +++ "is not a resource"
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 gr m c = do