クリーンな方法

Question

I下記のおもちゃの言語があります。

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

使用パターンマッチングを！

これは、私が参照

module Pattern where 

import Lang 


optimize :: Program -> Program 
optimize p 
    | p' <- reorder $ rewrite $ moveSkip p 
    , p /= p' = optimize p' 
    | otherwise = p 

rewrite :: Program -> Program 
rewrite (Move a : Move b : x) = rewrite $ Move (a+b) : x 
rewrite (Add a : Add b : x) = rewrite $ Add (a+b) : x 
rewrite (Move 0   : x) = rewrite x 
rewrite (Add 0   : x) = rewrite x 
rewrite (Skip : Skip : x) = rewrite x 
rewrite (Halt   : _) = [Halt] 
rewrite (Skip : x : xs) = Skip : x : rewrite xs 
rewrite (x : xs)  = x : rewrite xs 
rewrite []    = [] 

moveSkip :: Program -> Program 
moveSkip (Skip : a : x) = x ++ [Skip, a] 
moveSkip x = x 

reorder :: Program -> Program 
reorder (Move x : xs) 
    | (no_skips , Move y : xs') <- break isMove xs 
    , (no_skips' , Move w : q) <- break isMove xs' 
    , x == -y 
    , all (/=Skip) no_skips 
    , all (/=Skip) no_skips' 
    = Move x : no_skips ++ no_skips' ++ Move (w-x) : reorder q 
    | otherwise = Move x : reorder xs 
reorder (Skip : x : xs) = Skip : x : reorder xs 
reorder (x:xs) = x : reorder xs 
reorder []  = [] 

isMove (Move _) = True 
isMove _  = False 

Answer 2

利用たぶんだためにそれを掲示しています、私は避けたかったものです！ user2407038 @

は、私がコメント

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