saubere Art und Weise Rewrite-Regeln

Question

Ich habe folgendes Spielzeug Sprache zu tun:

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] 

Die Sprache hat eine endliche Band von Speicherzellen, die um Wraps, und einen Zeiger, die an einem bestimmten Zelle verweist. Alle Zellen sind anfänglich Null. Das Programm wird wiederholt ausgeführt, bis der Haltebefehl gelesen wird.

Jetzt möchte ich eine Funktion schreiben, die ein bestimmtes Programm optimiert. Hier sind die Optimierungen, die Ich mag würde auszuführen:

| 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   | 

Zusätzlich kann ich nur eine Optimierung auf Code tun, die nicht direkt nach einem Sprung ist, denn das tun würde, die Bedeutung des Programms ändern.

wiederholt auf der Liste Pattern-Matching, bis keine weiteren Optimierungen wirklich den besten/sauberste Weg, dies zu tun durchgeführt werden können?

Was passiert, wenn ich mich entscheide, dass ich auch weiter fortgeschritten umschreibt wie diese ausgeführt werden soll:

| 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

Verwenden Mustervergleich!

Dies ist, was ich vermeiden wollte, habe ich es

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

Verwenden Vielleicht Referenz bin Entsendung!

@ user2407038 sagte mir, dass ich vielleicht jede Optimierung (jede Zeile in der Tabelle) als Funktion `Programm

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