Permalink
Browse files

bf: primitive BrainFuck decompiler (InstrSet1)

  • Loading branch information...
EarlGray committed Jun 21, 2015
1 parent 3ecdf77 commit a13617a70cf09ee586014a65d3db4c0461d24219
Showing with 65 additions and 1 deletion.
  1. +1 −1 bf/Makefile
  2. +64 −0 bf/bfdecomp.hs
@@ -5,7 +5,7 @@ BF_SRC=brainfuck.cpp
MAIN_SRC=brhello.cpp


CC=gcc
CC=g++
CCFLAGS=-O3 -c -march=core2
LD=g++

@@ -0,0 +1,64 @@
import Control.Applicative
import Data.List
import Text.Printf

headOr :: String -> [a] -> a
headOr err [] = error err
headOr _ (hd : _ ) = hd

type Addr = Int

data InstrSet1
= IS1Add Addr Int
| IS1Sub Addr Int
| IS1LSta Addr Int
| IS1LEnd Addr Int
| IS1Put Addr
| IS1Get Addr
| IS1Lbl Int

fromBFtoInstrSet1 prog =
case foldl' go ([], 0, 1, []) prog of
(is1lst, _, _, _) -> demux $ reverse is1lst
where
demux =
let gradd (IS1Add p1 1) (IS1Add p2 1) = p1 == p2
gradd (IS1Sub p1 1) (IS1Sub p2 1) = p1 == p2
gradd _ _ = False
collect gr = case gr of
(IS1Add p 1 : _) -> IS1Add p (length gr)
(IS1Sub p 1 : _) -> IS1Sub p (length gr)
[op] -> op
in map collect . groupBy gradd
go (res, addr, lbln, branches) op =
case op of
'>' -> (res, succ addr, lbln, branches)
'<' -> (res, pred addr, lbln, branches)
'+' -> ((IS1Add addr 1 : res), addr, lbln, branches)
'-' -> ((IS1Sub addr 1 : res), addr, lbln, branches)
'[' -> let res' = (IS1Lbl (negate lbln) : IS1LSta addr lbln : res)
in (res', addr, succ lbln, (lbln : branches))
']' ->
case branches of
(lbl : branches') ->
let res' = (IS1Lbl lbl : IS1LEnd addr (negate lbl) : res)
in (res', addr, lbln, branches')
[] -> error "fromBFtoInstrSet1: mismatching ]"
'.' -> ((IS1Put addr : res), addr, lbln, branches)
',' -> ((IS1Get addr : res), addr, lbln, branches)
c -> error $ "fromBFtoInstrSet1 : unknown '" ++ [c] ++ "'"

showIS1 (IS1Add p n) = printf " add [%d] %d" p n
showIS1 (IS1Sub p n) = printf " sub [%d] %d" p n
showIS1 (IS1LSta p l) = printf " bnz [%d] %c%d" p (if l < 0 then 'b' else 'f') (abs l)
showIS1 (IS1LEnd p l) = printf " bz [%d] %c%d" p (if l < 0 then 'b' else 'f') (abs l)
showIS1 (IS1Lbl l) = printf "%c%d:" (if l < 0 then 'b' else 'f') (abs l)
showIS1 (IS1Get p) = printf " get [%d]" p
showIS1 (IS1Put p) = printf " put [%d]" p

instance Show InstrSet1 where show = showIS1

main = do
bfprog <- filter (`elem` "+-><.,[]") <$> getContents
mapM_ print $ fromBFtoInstrSet1 bfprog

0 comments on commit a13617a

Please sign in to comment.