diff options
| author | aarne <aarne@cs.chalmers.se> | 2006-06-02 15:42:57 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2006-06-02 15:42:57 +0000 |
| commit | f24ec8b8c2a25f62b47b74841c1fb6bd6af47c42 (patch) | |
| tree | bf937bcb80c7260e9f3851c17d72c18f06dd59bc /src/GF/Compile | |
| parent | 3ddb066a556a6b7666f2cf69030d7d0824e975d8 (diff) | |
also count lin in oper circ check (some problems remain)
Diffstat (limited to 'src/GF/Compile')
| -rw-r--r-- | src/GF/Compile/Optimize.hs | 12 |
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 |
