tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

e98fc7955feb673b86ac9176a211136493d6247b011cb80995fb53464028f976.tri (1889B)

      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 their diagnostics before invoking this algorithm.
      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. This small-graph
     38 -- algorithm uses linear membership/removal scans on each iteration.
     39 graphSort entries = (let rec
     40   walk pending available reversed = (case pending of
     41     [] = ok (reverse reversed) t
     42     [entry | _] = (lazyMaybe
     43       (_ : err (graphCycle (fst entry) pending) t)
     44       (ready : let name = fst ready in
     45         walk (graphRemove pending name) (pair name available) (pair name reversed))
     46       (graphFirstReady pending available))
     47     _ = err t t)
     48   in walk entries [] [])