mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -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
|
MGrammar (mod' : _) <- foldM evalOp gr ids
|
||||||
return $ mod'
|
return $ mod'
|
||||||
MTConcrete a -> do
|
MTConcrete a -> do
|
||||||
|
topoSortOpers $ allOperDependencies name js
|
||||||
js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
|
js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
|
||||||
return $ (name, ModMod (Module mt st fs me ops js'))
|
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
|
-- | auxiliaries for compiling the resource
|
||||||
allOperDependencies :: Ident -> BinTree Ident Info -> [(Ident,[Ident])]
|
allOperDependencies :: Ident -> BinTree Ident Info -> [(Ident,[Ident])]
|
||||||
allOperDependencies m b =
|
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
|
where
|
||||||
opersIn t = case t of
|
opersIn t = case t of
|
||||||
Q n c | n == m -> [c]
|
Q n c | n == m -> [c]
|
||||||
_ -> collectOp opersIn t
|
_ -> collectOp opersIn t
|
||||||
opty (Yes ty) = opersIn ty
|
opty (Yes ty) = opersIn ty
|
||||||
opty _ = []
|
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 :: [(Ident,[Ident])] -> Err [Ident]
|
||||||
topoSortOpers st = do
|
topoSortOpers st = do
|
||||||
let eops = topoTest st
|
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 :: SourceGrammar -> Type -> Err Term
|
||||||
mkLinDefault gr typ = do
|
mkLinDefault gr typ = do
|
||||||
|
|||||||
Reference in New Issue
Block a user