summaryrefslogtreecommitdiff
path: root/src/GF/Compile/Optimize.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2006-06-02 15:42:57 +0000
committeraarne <aarne@cs.chalmers.se>2006-06-02 15:42:57 +0000
commitf24ec8b8c2a25f62b47b74841c1fb6bd6af47c42 (patch)
treebf937bcb80c7260e9f3851c17d72c18f06dd59bc /src/GF/Compile/Optimize.hs
parent3ddb066a556a6b7666f2cf69030d7d0824e975d8 (diff)
also count lin in oper circ check (some problems remain)
Diffstat (limited to 'src/GF/Compile/Optimize.hs')
-rw-r--r--src/GF/Compile/Optimize.hs12
1 files changed, 10 insertions, 2 deletions
diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs
index 40514b75c..e68aa4f7d 100644
--- a/src/GF/Compile/Optimize.hs
+++ b/src/GF/Compile/Optimize.hs
@@ -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