mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-13 06:49:31 -06:00
also count lin in oper circ check (some problems remain)
This commit is contained in:
@@ -63,6 +63,7 @@ evalModule oopts ms mo@(name,mod) = case mod of
|
||||
MGrammar (mod' : _) <- foldM evalOp gr ids
|
||||
return $ mod'
|
||||
MTConcrete a -> do
|
||||
topoSortOpers $ allOperDependencies name js
|
||||
js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
|
||||
return $ (name, ModMod (Module mt st fs me ops js'))
|
||||
|
||||
@@ -212,18 +213,25 @@ recordExpand typ trm = case unComputed typ of
|
||||
-- | auxiliaries for compiling the resource
|
||||
allOperDependencies :: Ident -> BinTree Ident Info -> [(Ident,[Ident])]
|
||||
allOperDependencies m b =
|
||||
[(f, nub (opty pty ++ opty pt)) | (f, ResOper pty pt) <- tree2list b]
|
||||
[(f, nub (concatMap opty (pts i))) | (f,i) <- tree2list b]
|
||||
where
|
||||
opersIn t = case t of
|
||||
Q n c | n == m -> [c]
|
||||
_ -> collectOp opersIn t
|
||||
opty (Yes ty) = opersIn ty
|
||||
opty _ = []
|
||||
pts i = case i of
|
||||
ResOper pty pt -> [pty,pt]
|
||||
CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type))
|
||||
_ -> [] ---- ResParam
|
||||
|
||||
topoSortOpers :: [(Ident,[Ident])] -> Err [Ident]
|
||||
topoSortOpers st = do
|
||||
let eops = topoTest st
|
||||
either return (\ops -> Bad ("circular operations" +++ unwords (map prt (head ops)))) eops
|
||||
either
|
||||
return
|
||||
(\ops -> Bad ("circular definitions:" +++ unwords (map prt (head ops))))
|
||||
eops
|
||||
|
||||
mkLinDefault :: SourceGrammar -> Type -> Err Term
|
||||
mkLinDefault gr typ = do
|
||||
|
||||
Reference in New Issue
Block a user