Question

我有一个使用语句块的程序性EDSL。

尽管语句之间可能存在依赖关系，但这些语句没有按特定顺序添加到块中。

在编译EDSL期间，我需要确保语句按依赖顺序排序，例如

B := A
C := B
E := D

由于并非所有语句都具有依赖关系，因此没有总命令（例如，上面的E := D是独立的，可以放在任何地方）。没有循环依赖关系，因此列表排序应该是可能的。

我试图通过使用Data.List.sortBy和定义Ordering来修复解决方案，这将导致EQ表示语句没有依赖关系。这适用于一些例子，但不是在一般情况下，例如订购以下内容没有做任何事情：

C := B                           B := A
D := C    = should produce =>    C := B
B := A                           D := C

这是因为默认排序插入排序并且只确保插入的项目小于或等于下一项。

我已经在互联网上搜索了Poset的实现，但没有找到任何适用的东西：

altfloat:Data.Poset定义Ordering = LT | GT | EQ | NC（NC为非可比较），这是好的，但提供的sort假定为NaN - 就像不可比较的项目一样抛弃它们。

除了使用Maybe Ordering之外，

logfloat:Data.Number.PartialOrd与上述类似，我没有在包中的任何位置看到排序功能。

Math.Combinatorics.Poset我还没弄清楚如何使用它或它是否适用。

下面是一个包含绑定和非绑定语句的最小示例。非双重语句的顺序很重要，它们必须保持原始顺序（即排序需要稳定 w.r.t。不具有依赖关系的语句。）

我希望有一个简单的解决方案，而不使用完整的依赖图...

module Stmts where

import Data.List ( sortBy )

data Var = A | B | C | D | E | F | G | H deriving (Eq, Show)
data Stmt = Var := Var
          | Inc Var
  deriving (Show)

-- LHS variable
binds :: Stmt -> Maybe Var
binds (v := _) = Just v
binds _        = Nothing

-- RHS variables
references :: Stmt -> [Var]
references (_ := v) = [v]
references (Inc v)  = [v]

order :: [Stmt] -> [Stmt]
order = sortBy orderStmts

orderStmts :: Stmt -> Stmt -> Ordering
orderStmts s1 s2 = ord mbv1 mbv2
 where
  ord Nothing   Nothing   = EQ  -- No dep since they don't bind vars
  ord (Just v1) Nothing   = LT  -- Binding statements have precedence
  ord Nothing   (Just v2) = GT  -- ^^^
  ord (Just v1) (Just v2)       -- Both statements are binding:
    | v1 `elem` refs2 = LT      --  * s2 depends on s1
    | v2 `elem` refs1 = GT      --  * s1 depends on s2
    | otherwise       = EQ      --  * neither

  -- *Maybe* they bind variables
  mbv1  = binds s1
  mbv2  = binds s2

  -- Variables they reference  
  refs1 = references s1
  refs2 = references s2

-- The following should return [B := A, C := B, D := C, Inc F, Inc G]
test = order [Inc F, Inc G, C := B, D := C, B := A]

Answer 1

您的方法存在的问题是您的orderStmts既不是排序也不是部分排序。特别是，它不是transitive，这就是使用它进行排序的尝试失败的原因。

您要找的是topological sorting。你有一个顶点（语句）图形，它们之间有它们的边缘（它们的依赖关系），你想确保排序与边缘匹配。

我只关注声明，因为非绑定语句很容易（我们只需要将列表拆分为两个，对声明进行排序并再次连接）。

拓扑排序已经在Data.Graph中实现，这使任务变得非常简单：

module Stmts where

import Data.Graph

data Var = A | B | C | D | E | F | G | H deriving (Eq, Ord, Show)

data Decl = Var := Var 
  deriving (Show, Eq)

data Stmt = Decl
          | Inc Var
  deriving (Show, Eq)

sortDecls :: [Decl] -> [SCC Decl]
sortDecls = stronglyConnComp . map triple
  where
    triple n@(x := y)   = (n, x, [y])

-- The following should return [B := A, C := B, D := C]
test = map flattenSCC . sortDecls $ [C := B, D := C, B := A]

调用flattenSCC仅用于测试，因为SCC没有Show实例。您可能希望检查SCC的周期（一个周期将是语言编译错误），如果没有，则提取已排序的序列。

Answer 2

我认为对语句组进行排序的唯一方法是从根到儿童

import Data.List

data Var = A | B | C | D | E | F | G | H deriving (Eq, Show)
data Stmt = Var := Var deriving (Show)

parent :: Stmt -> Var
parent (_ := p) = p

child :: Stmt -> Var
child (c := _) = c

steps :: [Stmt] -> [[Stmt]]
steps st = step roots st
  where step _ [] = []
        step r s = let (a, b) = partition (flip elem r . parent) s
                       (v, u) = partition (flip elem (map child b) . child ) a
                   in  if null u then error "Cycle!"
                                 else u : step (r ++ (nub $ map child u)) (v ++ b)

        roots = let cs = map child st
                    rs = nub $ filter (not . flip elem cs) (map parent st)
                in  if null rs then error "No roots!"
                               else rs

main = mapM_ print $ steps [F := H, G := H, C := B, D := C, B := A]

带输出

[F := H,G := H,B := A]
[C := B]
[D := C]

当＆＃34;排序＆＃34;超过群体（不是陈述）。

（此代码已授予稳定性，因为partition，map，++，...不等。<）

<强>（添加）

如果你真的希望有一些稳定属性（对语句进行排序），你必须添加一些其他限制（定义＆＃34;稳定性＆＃34;）。

让两个＆＃34;排序＆＃34;直接算法（简单地将语句重新排序到前面或后面）

orderToFront :: [Stmt] -> [Stmt]
orderToFront [] = []
orderToFront (s@(_ := p):xs) = let (l, r) = splitAtFirst ((==p).child) xs
                               in  if null r then s: orderToFront xs
                                             else head r: s: orderToFront (l ++ tail r)

orderToBack' :: [Stmt] -> [Stmt]
orderToBack' [] = []
orderToBack' (s@(c := _):xs) = let (l, r) = splitAtFirst ((==c).parent) xs
                               in  if null r then s: orderToBack' xs
                                             else orderToBack' (l ++ head r: s: tail r)
orderToBack = reverse . orderToBack'

splitAtFirst :: (a -> Bool) -> [a] -> ([a], [a])
splitAtFirst f xs = let rs = dropWhile (not.f) xs
                    in  (take (length xs - length rs) xs, rs)


main = do

    let q = [F := H, C := B, D := C, G := F, B := A]

    putStrLn "-- orderToFront"
    mapM_ print $ orderToFront q

    putStrLn "-- orderToBack"
    mapM_ print $ orderToBack q

使用相同的输入，orderToFront输出与orderToBack输出不同但两者都有效

-- orderToFront
F := H
B := A
C := B
D := C
G := F
-- orderToBack
B := A
F := H
G := F
C := B
D := C

（只有等式关系，你的算法不能低于O（n ^ 2），但如果你定义稳定性限制，它可以减少）

如何在Haskell中使用部分顺序对列表进行排序？

2 个答案: