干净的方式来重写规则

Question

我有以下玩具语言：

module Lang where

data Op = Move Int -- Move the pointer N steps
        | Add  Int -- Add N to the value under the pointer
        | Skip     -- Skip next op if the value under the pointer is 0
        | Halt     -- End execution
        deriving (Show, Eq)

type Program = [Op]

该语言包含有限的内存单元磁带，以及指向某个单元的指针。所有细胞最初都为零。重复执行程序，直到读取暂停指令。

现在我想编写一个优化给定程序的函数。以下是我想要执行的优化：

| Original code       | Optimization   |
|---------------------|----------------|
| Move a : Move b : x | Move (a+b) : x |
| Add  a : Add  b : x | Add  (a+b) : x |
| Move 0 : x          | x              |
| Add  0 : x          | x              |
| Skip : Skip : x : y | x : y          |
| Halt : _            | Halt           |

此外，我只能对跳过后不直接的代码进行优化，因为这样做会改变程序的含义。

列表上是否重复进行模式匹配，直到无法进行更多优化才能真正做到最好/最干净的方式？

如果我决定要执行更高级的重写，请执行以下操作：

| Original code                                          | Optimization                                   |
|--------------------------------------------------------|------------------------------------------------|
| if the program begins with (Skip : a)                  | move it to the end of the program              |
| Move x ++ no_skips : Move -x ++ no_skips' : Move w : q | Move x ++ no_skips ++ no_skips' : Move w-x : q |

Answer 1

使用Maybe＆＃39; s

@ user2407038告诉我，我可以在评论中使用Maybe

module MaybeProg where

import Lang
import Control.Monad

type Opt = Program -> Maybe Program

optimize = untilFail step
  where step p | p' <- atEveryButSkipNextWhen (==Skip) rewrite
                     . atEvery   delNopSkip
                     $ untilFail moveSkips p
               , p /= p' = Just p'
               | otherwise = Nothing
        rewrite = tryAll [joinMoves, joinAdds, delNopMov, delNopAdd, termHalt, reorder]

joinMoves  p = do (Move a : Move b : x) <- pure p; Just $ Move (a+b) : x
joinAdds   p = do (Add  a : Add  b : x) <- pure p; Just $ Add  (a+b) : x
delNopMov  p = do (Move 0          : x) <- pure p; Just x
delNopAdd  p = do (Add  0          : x) <- pure p; Just x
delNopSkip p = do (Skip   : Skip   : x) <- pure p; Just x
termHalt   p = do (Halt            : _) <- pure p; Just [Halt]
moveSkips  p = do (Skip   : x : y  : z) <- pure p; Just $ y : z ++ [Skip, x]

reorder p = do
  (Move x : rst)      <- pure p
  (as, Move y : rst') <- break' isMove rst
  guard $ x == -y && all (/=Skip) as
  (bs, Move w :   q ) <- break' isMove rst'
  guard $ all (/=Skip) bs
  return $ Move x : as ++ bs ++ Move (w-x) : q
 where isMove (Move _) = True
       isMove _        = False

--------

untilFail :: Opt -> Program -> Program
untilFail o p | Just p' <- o p = untilFail o p'
              | otherwise   = p

atEvery :: Opt -> Program -> Program
atEvery o p | (x:xs) <- untilFail o p = x : atEvery o xs
            | otherwise               = []

atEveryButSkipNextWhen c o p@(h:_)
  | not $ c h
  , (x:xs) <- untilFail o p = x : atEveryButSkipNextWhen c o xs
  | (p1:p2:ps) <- p = p1:p2:atEveryButSkipNextWhen c o ps
  | otherwise = p
atEveryButSkipNextWhen _ _ [] = []

tryAll :: [Opt] -> Opt
tryAll os p = do
  Just x : _ <- pure . dropWhile (==Nothing) $ ($p) <$> os
  return x

break' f p | (x, y) <- break f p
           , not $ null y = Just (x, y)
           | otherwise = Nothing

Answer 2

使用模式匹配！

这是我想避免的，我将其张贴以供参考

                     <a
                         ng-show="isManagedMeetingMandatory"
                         class="glyphicon glyphicon-question-sign"
                         target="_blank"
                         ng-href="{{dynamicUrl}}"
                         uib-tooltip-html="'{{dynamicMsg}}'"
                         tooltip-placement="right"
                         tooltip-append-to-body="true">
                     </a>