tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

graph.tri (1975B)

      1 !import base *
      2 !export *
      3 
      4 -- Entries are (name, dependency names). Names are opaque trees. Lists must be
      5 -- proper, names unique, and every dependency present: frontend validation owns
      6 -- these checks and its diagnostics. This is not a malformed-graph validator.
      7 graphFind entries name = find (entry : equal? (fst entry) name) entries
      8 graphContains names name = any? (equal? name) names
      9 graphReady dependencies available = all? (graphContains available) dependencies
     10 graphFirstReady entries available = find (entry : graphReady (snd entry) available) entries
     11 
     12 graphRemove entries name = (case entries of
     13   [] = []
     14   [entry | rest] = (lazyBool
     15     (_ : rest)
     16     (_ : pair entry (graphRemove rest name))
     17     (equal? (fst entry) name))
     18   _ = [])
     19 
     20 graphFirstPending dependencies entries = find (name : maybe? (graphFind entries name)) dependencies
     21 
     22 -- Follow pending edges to the first repeated name: the witness belongs to the
     23 -- cycle, even when the first blocked node merely leads into that cycle.
     24 graphCycle current entries = (let rec
     25   walk name seen = (lazyBool
     26     (_ : name)
     27     (_ : lazyMaybe
     28       (_ : name)
     29       (entry : lazyMaybe
     30         (_ : name)
     31         (dependency : walk dependency (pair name seen))
     32         (graphFirstPending (snd entry) entries))
     33       (graphFind entries name))
     34     (graphContains seen name))
     35   in walk current [])
     36 
     37 -- Select the earliest currently ready entry each round (not FIFO batches).
     38 -- This simple small-graph algorithm retains linear membership/removal scans;
     39 -- it does not promise O(V+E) sorting for large dependency graphs.
     40 graphSort entries = (let rec
     41   walk pending available reversed = (case pending of
     42     [] = ok (reverse reversed) t
     43     [entry | _] = (lazyMaybe
     44       (_ : err (graphCycle (fst entry) pending) t)
     45       (ready : let name = fst ready in
     46         walk (graphRemove pending name) (pair name available) (pair name reversed))
     47       (graphFirstReady pending available))
     48     _ = err t t)
     49   in walk entries [] [])