GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-08-19 18:56:21 -06:00
Code Issues Packages Projects Releases Wiki Activity

a bit better but not perfect dependency checker

Browse Source
This commit is contained in:
Krasimir Angelov
2026-02-14 18:34:07 +01:00
parent c8f34ff9e2
commit c2aa109cd9
1 changed files with 12 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/compiler/api/GF/Grammar/Macros.hs
+12 -9
View File
@@ -30,6 +30,7 @@ import qualified Data.Traversable as T(mapM)
import qualified Data.Map as Map import qualified Data.Map as Map
import Control.Monad (liftM, liftM2, liftM3, forM) import Control.Monad (liftM, liftM2, liftM3, forM)
import Data.List (nub) import Data.List (nub)
import Data.Maybe (fromMaybe)
import Data.Monoid import Data.Monoid
import Data.Graph import Data.Graph
import GF.Text.Pretty(render,(<+>),($$),hsep,fsep,vcat,nest) import GF.Text.Pretty(render,(<+>),($$),hsep,fsep,vcat,nest)
@@ -457,7 +458,7 @@ changeTableType co i = case i of
allDependencies :: (ModuleName -> Bool) -> Map.Map Ident Info -> [(Ident,Info,[Ident])] allDependencies :: (ModuleName -> Bool) -> Map.Map Ident Info -> [(Ident,Info,[Ident])]
allDependencies ism b = allDependencies ism b =
[(f, i, nub (concatMap opty (pts i))) | (f,i) <- Map.toList b] [(f, i, nub (deps i)) | (f,i) <- Map.toList b]
where where
opersIn t = case t of opersIn t = case t of
Q (n,c) | ism n -> [c] Q (n,c) | ism n -> [c]
@@ -467,6 +468,8 @@ allDependencies ism b =
_ -> collectOp opersIn t _ -> collectOp opersIn t
opersInPatt p = case p of opersInPatt p = case p of
PP (n,c) ps -> (if ism n then (:)c else id)
(concatMap opersInPatt ps)
PTilde t -> opersIn t PTilde t -> opersIn t
PM (n,c) | ism n -> [c] PM (n,c) | ism n -> [c]
_ -> collectPattOp opersInPatt p _ -> collectPattOp opersInPatt p
@@ -474,14 +477,14 @@ allDependencies ism b =
opty (Just (L _ ty)) = opersIn ty opty (Just (L _ ty)) = opersIn ty
opty _ = [] opty _ = []
pts i = case i of deps i = case i of
ResOper pty pt -> [pty,pt] ResOper pty pt -> opty pty ++ opty pt
ResOverload _ tyts -> concat [[Just ty, Just tr] | (ty,tr) <- tyts] ResOverload _ tyts -> concat [opersIn ty ++ opersIn tr | (L _ ty,L _ tr) <- tyts]
ResParam (Just (L loc ps)) _ -> [Just (L loc t) | (_,cont) <- ps, (_,_,t) <- cont] ResParam (Just (L loc ps)) _ -> concat [opersIn t | (_,cont) <- ps, (_,_,t) <- cont]
CncCat pty _ _ _ _ -> [pty] CncCat pty _ _ _ _ -> opty pty
CncFun _ pt _ _ -> [pt] ---- (Maybe (Ident,(Context,Type)) CncFun _ pt _ _ -> opty pt
AbsFun pty ptr -> [pty] --- ptr is def, which can be mutual AbsFun pty peqs -> opty pty ++ [c | L _ (ps,t) <- maybe [] snd peqs, c <- concatMap opersInPatt ps]
AbsCat (Just (L loc co)) -> [Just (L loc ty) | (_,_,ty) <- co] AbsCat (Just (L loc co)) -> concat [opersIn ty | (_,_,ty) <- co]
_ -> [] _ -> []
topoSortJments :: ErrorMonad m => SourceModule -> m [(Ident,Info)] topoSortJments :: ErrorMonad m => SourceModule -> m [(Ident,Info)]