Small dependency ordering optimizations
This commit is contained in:
parent
c9d0d04630
commit
72291c652d
@ -62,4 +62,4 @@ jobs:
|
||||
./tricu
|
||||
token: '${{ secrets.RELEASE_TOKEN }}'
|
||||
body: '${{ gitea.event.head_commit.message }}'
|
||||
pre_release: true
|
||||
prerelease: true
|
||||
|
54
src/Eval.hs
54
src/Eval.hs
@ -3,7 +3,7 @@ module Eval where
|
||||
import Parser
|
||||
import Research
|
||||
|
||||
import Data.List (partition)
|
||||
import Data.List (partition, (\\))
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
@ -122,17 +122,20 @@ reorderDefs env defs
|
||||
| otherwise = orderedDefs ++ others
|
||||
where
|
||||
(defsOnly, others) = partition isDef defs
|
||||
graph = buildDepGraph defsOnly
|
||||
sortedDefs = sortDeps graph
|
||||
defMap = Map.fromList [(name, def) | def@(SDef name _ _) <- defsOnly]
|
||||
orderedDefs = map (\name -> defMap Map.! name) sortedDefs
|
||||
topDefNames = Set.fromList (Map.keys defMap)
|
||||
envNames = Set.fromList (Map.keys env)
|
||||
freeVarsDefs = foldMap (\(SDef _ _ body) -> freeVars body) defsOnly
|
||||
freeVarsOthers = foldMap freeVars others
|
||||
allFreeVars = freeVarsDefs <> freeVarsOthers
|
||||
validNames = topDefNames `Set.union` envNames
|
||||
missingDeps = Set.toList (allFreeVars `Set.difference` validNames)
|
||||
defNames = [ name | SDef name _ _ <- defsOnly ]
|
||||
|
||||
defsWithFreeVars = [(def, freeVars body) | def@(SDef _ _ body) <- defsOnly]
|
||||
|
||||
graph = buildDepGraph defsOnly
|
||||
sortedDefs = sortDeps graph
|
||||
defMap = Map.fromList [(name, def) | def@(SDef name _ _) <- defsOnly]
|
||||
orderedDefs = map (\name -> defMap Map.! name) sortedDefs
|
||||
|
||||
freeVarsDefs = foldMap snd defsWithFreeVars
|
||||
freeVarsOthers = foldMap freeVars others
|
||||
allFreeVars = freeVarsDefs <> freeVarsOthers
|
||||
validNames = Set.fromList defNames `Set.union` Set.fromList (Map.keys env)
|
||||
missingDeps = Set.toList (allFreeVars `Set.difference` validNames)
|
||||
|
||||
isDef (SDef _ _ _) = True
|
||||
isDef _ = False
|
||||
@ -153,20 +156,21 @@ buildDepGraph topDefs
|
||||
countOccurrences = foldr (\x -> Map.insertWith (+) x 1) Map.empty
|
||||
|
||||
sortDeps :: Map.Map String (Set.Set String) -> [String]
|
||||
sortDeps graph = go [] (Map.keys graph)
|
||||
sortDeps graph = go [] Set.empty (Map.keys graph)
|
||||
where
|
||||
go sorted [] = sorted
|
||||
go sorted remaining
|
||||
| null ready =
|
||||
errorWithoutStackTrace
|
||||
"ERROR: Top-level cyclic dependency detected and prohibited\n\
|
||||
\RESOLVE: Use nested lambdas"
|
||||
| otherwise = go (sorted ++ ready) notReady
|
||||
where
|
||||
ready = [ name | name <- remaining
|
||||
, all (`elem` sorted) (Set.toList (graph Map.! name))]
|
||||
notReady =
|
||||
[ name | name <- remaining , name `notElem` ready]
|
||||
go sorted sortedSet [] = sorted
|
||||
go sorted sortedSet remaining =
|
||||
let ready = [ name | name <- remaining
|
||||
, let deps = Map.findWithDefault Set.empty name graph
|
||||
, Set.isSubsetOf deps sortedSet ]
|
||||
notReady = remaining \\ ready
|
||||
in if null ready
|
||||
then errorWithoutStackTrace
|
||||
"ERROR: Cyclic dependency detected and prohibited.\n\
|
||||
\RESOLVE: Use nested lambdas."
|
||||
else go (sorted ++ ready)
|
||||
(Set.union sortedSet (Set.fromList ready))
|
||||
notReady
|
||||
|
||||
depends :: [TricuAST] -> TricuAST -> Set.Set String
|
||||
depends topDefs (SDef _ _ body) =
|
||||
|
Loading…
x
Reference in New Issue
Block a user