Skip to content

Instantly share code, notes, and snippets.

@thedeemon
Created January 5, 2015 17:03
Show Gist options
  • Save thedeemon/d9dfe4982ab6c5e68854 to your computer and use it in GitHub Desktop.
Save thedeemon/d9dfe4982ab6c5e68854 to your computer and use it in GitHub Desktop.
micro interpreter in Haskell
import Data.List
import Control.Monad.ST
import Control.Monad
import Data.Array.ST
import Data.Array.Unboxed
data Exp = IfGt Int Int Block Block -- if a[i] > a[j] then blk1 else blk2
| Swap Int Int -- a[i] <-> a[j] (i,j < 8)
| Copy Int Int -- a[i] <- a[j] (i > 7)
deriving Show
type Block = [Exp]
eval :: STUArray s Int Int -> Exp -> ST s (STUArray s Int Int, Int)
eval a (IfGt i j b1 b2) = do
ai <- readArray a i
aj <- readArray a j
let b = if ai > aj then b1 else b2
(r, n) <- evalBlock a b
return (r, n+1)
eval a (Swap i j) = do
ai <- readArray a i
aj <- readArray a j
writeArray a i aj
writeArray a j ai
return (a, 1)
eval a (Copy i j) = do
aj <- readArray a j
writeArray a i aj
return (a, 1)
evalBlock :: STUArray s Int Int -> Block -> ST s (STUArray s Int Int, Int)
evalBlock a blk = foldM f (a,0) blk where
f (a,cnt) exp = fmap (\(r, n) -> (r, cnt + n)) $ eval a exp
numSteps :: Block -> UArray Int Int -> Int
numSteps blk ua = runST $ do
a <- thaw ua
(r, n) <- evalBlock a blk
r1 <- readArray r 1
r6 <- readArray r 6
return $ if r1 == 2 && r6 == 7 then n else 25000
inputs :: [UArray Int Int]
inputs = let ps = permutations [1..8]
zs = [0,0,0,0]
in [runSTUArray $ newListArray (0, 11) (p ++ zs) | p <- ps]
calcScore :: Block -> Int
calcScore blk = sum $ map (numSteps blk) inputs
cmp_swap i j = IfGt i j [Swap i j] []
mksornet cmp =
[cmp 0 1, cmp 2 3, cmp 4 5, cmp 6 7,
cmp 0 2, cmp 1 3, cmp 4 6, cmp 5 7,
cmp 1 2, cmp 5 6, cmp 0 4, cmp 3 7,
cmp 1 5, cmp 2 6,
cmp 1 4, cmp 3 6]
sornet :: Block
sornet = mksornet cmp_swap
main = print . minimum . map calcScore $ replicate 40 sornet
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment